cgit.sxemacs.org Git - gnus/blob - lisp/gnus-uu.el

   1 ;;; gnus-uu.el --- extract, view or save (uu)encoded files from Gnus
   2 ;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Created: 2 Oct 1993
   6 ;; Version: v2.9.4
   7 ;; Last Modified: 1994/10/03
   8 ;; Keyword: news
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; All gnus-uu commands start with `C-c C-v'.
  29 ;;
  30 ;; Short user manual for this package:
  31 ;;
  32 ;; Type `C-c C-v C-v' to decode and view all articles of the current
  33 ;; series. The defaults should be reasonable for most systems.
  34 ;;
  35 ;; Type `C-c C-v C-i' to toggle interactive mode. When using
  36 ;; interactive mode, gnus-uu will which display a buffer that will let
  37 ;; you see the suggested commands to be executed.
  38 ;;
  39 ;; To post an uuencoded file, type `C-c C-v p', which will enter you
  40 ;; into a buffer analogous to the one you will get when typing `a'. Do
  41 ;; an `M-x describe-mode' in this buffer to get a description of what
  42 ;; this buffer lets you do.
  43 ;;
  44 ;; Read the documentation of the `gnus-uu' dummy function for a more
  45 ;; complete description of what this package does and how you can
  46 ;; customize it to fit your needs.
  47 ;;
  48 ;;
  49 ;;
  50 ;; History
  51 ;;
  52 ;; v1.0: First version released Oct 2 1992.
  53 ;;
  54 ;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'.
  55 ;; Changed (setq gnus-exit-group-hook) to (add-hook).  Removed
  56 ;; checking for "Re:" for finding parts.
  57 ;;
  58 ;; v2.2: Fixed handling of currupted archives. Changed uudecoding to
  59 ;; an asynchronous process to avoid loading tons of data into emacs
  60 ;; buffers. No longer reads articles emacs already have aboard.  Fixed
  61 ;; a firmer support for shar files. Made regexp searches for files
  62 ;; more convenient. Added `C-c C-l' for editing uucode begin
  63 ;; lines. Added multi-system decoder entry point. Added interactive
  64 ;; view mode. Added function for decoding and saving all uuencoded
  65 ;; articles in the current newsgroup.
  66 ;;
  67 ;; v2.3: After suggestions I have changed all the gnus-uu key bindings
  68 ;; to avoid hogging all the user keys (C-c LETTER). Also added
  69 ;; (provide) and fixed some saving stuff. First posted version to
  70 ;; gnu.emacs.sources.
  71 ;;
  72 ;; v2.4: Fixed some more in the save-all category. Automatic fixing of
  73 ;; uucode "begin" lines: names on the form of "dir/file" are
  74 ;; translated into "dir-file". Added a function for fixing stripped
  75 ;; uucode articles. Added binhex save.
  76 ;;
  77 ;; v2.5: First version copyrighted by FSF. Changed lots of
  78 ;; documentation strings.
  79 ;;
  80 ;; v2.5.1: Added uuencode/posting code to post binary files.
  81 ;;
  82 ;; v2.6: Thread support. gnus-uu is now able to decode uuencoded files
  83 ;; posted in threads. gnus-uu can also post in threads. I don't know
  84 ;; if this ability is of much use - I've never seen anyone post
  85 ;; uuencoded files in threads.
  86 ;;
  87 ;; v2.7: gnus-uu is now able to decode (and view/save) multiple
  88 ;; encoded files in one big gulp. Also added pseudo-mime support
  89 ;; (users can use metamail to view files), posting uuencoded/mime
  90 ;; files and various other bits and pieces.
  91 ;;
  92 ;; v2.7.1: New functions for decoding/saving threads bound to `C-c
  93 ;; C-v C-j'. Handy to save entire threads, not very useful for
  94 ;; decoding, as nobody posts encoded files in threads...
  95 ;;
  96 ;; v2.7.2: New functions for digesting and forwarding articles added
  97 ;; on the suggestion of Per Abrahamsen. Also added a function for
  98 ;; marking threads.
  99 ;;
 100 ;; v2.8: Fixed saving original files in interactive mode. Fixed ask
 101 ;; before/save after view. Fixed setting up interactive buffers. Added
 102 ;; scanning and rescanning from interactive mode. Added the
 103 ;; `gnus-uu-ignore-file-by-name' and `...-by-type' variables to allow
 104 ;; users to sift files they don't want to view. At the suggestion of
 105 ;; boris@cs.rochester.edu, `C-c C-v C-h' has been undefined to allow
 106 ;; users to view list of binding beginning with `C-c C-v'. Fixed
 107 ;; viewing with `gnus-uu-asynchronous' set. The
 108 ;; "decode-and-save/view-all-articles" functions now accepts the
 109 ;; numeric prefix to delimit the maximum number of files to be
 110 ;; decoded.
 111 ;;
 112 ;; v2.9: Speeded up fetching of articles by bypassing the gnus
 113 ;; function and going directly to `gnus-request-article'
 114 ;; instead. Significant speed increase, especially when using a local
 115 ;; spool. Added the `gnus-uu-universal-prefix' command (`C-c C-v C-u')
 116 ;; to allow users to perform any job on all marked articles.
 117 ;;
 118 ;; v2.9.1: Disabled buffer-undo, which stopped gnus-uu from making
 119 ;; emacs *very* large in big newsgroups.
 120 ;;
 121 ;; v2.9.2: A few minor bug-fixes.
 122 ;;
 123 ;; v2.9.3: Finally managed to fix the bug that made gnus-uu core dump
 124 ;; emacs in huge newsgroups. The error was a result of not deleting a
 125 ;; process that had terminated with an error, which led to
 126 ;; select() failing miserably later. Added the `C-c C-v M-C-w' and
 127 ;; `C-c C-v M-w' keystrokes and the `...-marked-files' functions to
 128 ;; allow users to walk around the newsgroup and mark some articles
 129 ;; here and there, without having to worry about marking exactly
 130 ;; right, and then decoding all files that had had some articles
 131 ;; marked.
 132
 133 ;;; Code:
 134
 135 (require 'gnus)
 136
 137 ;; Binding of keys to the gnus-uu functions.
 138
 139 (defvar gnus-uu-ctl-map nil)
 140 (define-prefix-command 'gnus-uu-ctl-map)
 141 (define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map)
 142
 143 (define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view)
 144 (define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save)
 145 (define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view)
 146 (define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save)
 147 (define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view)
 148 (define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save)
 149
 150 (define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer)
 151
 152 (define-key gnus-uu-ctl-map "u" 'gnus-summary-unmark-all-processable)
 153 (define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp)
 154 (define-key gnus-uu-ctl-map "r" 'gnus-uu-mark-region)
 155 (define-key gnus-uu-ctl-map "t" 'gnus-uu-mark-thread)
 156
 157 (define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-marked-universal-argument)
 158
 159 (define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view)
 160 (define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save)
 161 (define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view)
 162 (define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save)
 163 (define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view)
 164 (define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save)
 165
 166 (define-key gnus-uu-ctl-map "f" 'gnus-uu-digest-and-forward)
 167 (define-key gnus-uu-ctl-map "\M-f" 'gnus-uu-marked-digest-and-forward)
 168
 169 (define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view)
 170 (define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable)
 171
 172 (define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line)
 173
 174 (define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles)
 175 (define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles)
 176 (define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles)
 177 (define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles)
 178 (define-key gnus-uu-ctl-map "\M-\C-w" 'gnus-uu-decode-and-view-all-marked-files)
 179 (define-key gnus-uu-ctl-map "\M-w" 'gnus-uu-decode-and-save-all-marked-files)
 180
 181 (define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view)
 182 (define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save)
 183
 184 (define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news)
 185
 186 ;; Dummy function gnus-uu
 187
 188 (defun gnus-uu ()
 189   "gnus-uu is a package for uudecoding and viewing articles."
 190   (interactive))
 191
 192 ;; Default viewing action rules
 193
 194 (defvar gnus-uu-default-view-rules
 195   (list
 196    '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
 197    '("\\.tga$" "tgatoppm %s | xv -")
 198    '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less")
 199    '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
 200      "sox -v .5 %s -t .au -u - > /dev/audio")
 201    '("\\.au$" "cat %s > /dev/audio")
 202    '("\\.mod$" "str32")
 203    '("\\.ps$" "ghostview")
 204    '("\\.dvi$" "xdvi")
 205    '("\\.[1-6]$" "xterm -e groff -mandoc -Tascii")
 206    '("\\.html$" "xmosaic")
 207    '("\\.mpe?g$" "mpeg_play")
 208    '("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
 209    '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
 210      "gnus-uu-archive"))
 211
 212   "Default actions to be taken when the user asks to view a file.
 213 To change the behaviour, you can either edit this variable or set
 214 `gnus-uu-user-view-rules' to something useful.
 215
 216 For example:
 217
 218 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
 219 following in your .emacs file
 220
 221   (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\")))
 222
 223 Both these variables are lists of lists with two string elements. The
 224 first string is a regular expression. If the file name matches this
 225 regular expression, the command in the second string is executed with
 226 the file as an argument.
 227
 228 If the command string contains \"%s\", the file name will be inserted
 229 at that point in the command string. If there's no \"%s\" in the
 230 command string, the file name will be appended to the command string
 231 before executing.
 232
 233 There are several user variables to tailor the behaviour of gnus-uu to
 234 your needs. First we have `gnus-uu-user-view-rules', which is the
 235 variable gnus-uu first consults when trying to decide how to view a
 236 file. If this variable contains no matches, gnus-uu examines the
 237 default rule vaiable provided in this package. If gnus-uu finds no
 238 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
 239 match.
 240
 241 Unless, of course, you are using the interactive view mode. Then
 242 `gnus-uu-user-interactive-view-rules' and
 243 `gnus-uu-user-interactive-view-rules-end' will be used instead.")
 244
 245 (defvar gnus-uu-user-view-rules nil
 246   "Variable detailing what actions are to be taken to view a file.
 247 See the documentation on the `gnus-uu-default-view-rules' variable for
 248 details.")
 249
 250 (defvar gnus-uu-user-view-rules-end nil
 251   "Variable saying what actions are to be taken if no rule matched the file name.
 252 See the documentation on the `gnus-uu-default-view-rules' variable for
 253 details.")
 254
 255 (defvar gnus-uu-user-interactive-view-rules nil
 256   "Variable detailing what actions are to be taken to view a file when using interactive mode.
 257 See the documentation on the `gnus-uu-default-view-rules' variable for
 258 details.")
 259
 260 (defvar gnus-uu-user-interactive-view-rules-end nil
 261   "Variable saying what actions are to be taken if no rule matched the file name when using interactive mode.
 262 See the documentation on the `gnus-uu-default-view-rules' variable for
 263 details.")
 264
 265 (defvar gnus-uu-default-interactive-view-rules-begin
 266   (list
 267    '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
 268    '("\\.pas$" "cat %s | sed s/\r//g")
 269    '("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
 270    ))
 271
 272 (defvar gnus-uu-default-interactive-view-rules-end
 273   (list
 274    '(".*" "file")))
 275
 276 ;; Default unpacking commands
 277
 278 (defvar gnus-uu-default-archive-rules
 279   (list '("\\.tar$" "tar xf")
 280         '("\\.zip$" "unzip -o")
 281         '("\\.ar$" "ar x")
 282         '("\\.arj$" "unarj x")
 283         '("\\.zoo$" "zoo -e")
 284         '("\\.\\(lzh\\|lha\\)$" "lha x")
 285         '("\\.Z$" "uncompress")
 286         '("\\.gz$" "gunzip")
 287         '("\\.arc$" "arc -x"))
 288   )
 289
 290 (defvar gnus-uu-destructive-archivers
 291   (list "uncompress" "gunzip"))
 292
 293 (defvar gnus-uu-user-archive-rules nil
 294   "A list that can be set to override the default archive unpacking commands.
 295 To use, for instance, 'untar' to unpack tar files and 'zip -x' to
 296 unpack zip files, say the following:
 297   (setq gnus-uu-user-archive-rules
 298     (list '(\"\\\\.tar$\" \"untar\")
 299           '(\"\\\\.zip$\" \"zip -x\")))")
 300
 301 (defvar gnus-uu-ignore-files-by-name nil
 302   "A regular expression saying what files should not be viewed based on name.
 303 If, for instance, you want gnus-uu to ignore all .au and .wav files,
 304 you could say something like
 305
 306   (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
 307
 308 Note that this variable can be used in conjunction with the
 309 `gnus-uu-ignore-files-by-type' variable.")
 310
 311 (defvar gnus-uu-ignore-files-by-type nil
 312   "A regular expression saying what files that shouldn't be viewed, based on MIME file type.
 313 If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
 314 you could say something like
 315
 316   (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
 317
 318 Note that this variable can be used in conjunction with the
 319 `gnus-uu-ignore-files-by-name' variable.")
 320
 321 ;; Pseudo-MIME support
 322
 323 (defconst gnus-uu-ext-to-mime-list
 324   (list '("\\.gif$" "image/gif")
 325         '("\\.jpe?g$" "image/jpeg")
 326         '("\\.tiff?$" "image/tiff")
 327         '("\\.xwd$" "image/xwd")
 328         '("\\.pbm$" "image/pbm")
 329         '("\\.pgm$" "image/pgm")
 330         '("\\.ppm$" "image/ppm")
 331         '("\\.xbm$" "image/xbm")
 332         '("\\.pcx$" "image/pcx")
 333         '("\\.tga$" "image/tga")
 334         '("\\.ps$" "image/postscript")
 335         '("\\.fli$" "video/fli")
 336         '("\\.wav$" "audio/wav")
 337         '("\\.aiff$" "audio/aiff")
 338         '("\\.hcom$" "audio/hcom")
 339         '("\\.voc$" "audio/voc")
 340         '("\\.smp$" "audio/smp")
 341         '("\\.mod$" "audio/mod")
 342         '("\\.dvi$" "image/dvi")
 343         '("\\.mpe?g$" "video/mpeg")
 344         '("\\.au$" "audio/basic")
 345         '("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
 346         '("\\.\\(c\\|h\\)$" "text/source")
 347         '("read.*me" "text/plain")
 348         '("\\.html$" "text/html")
 349         '("\\.bat$" "text/bat")
 350         '("\\.[1-6]$" "text/man")
 351         '("\\.flc$" "video/flc")
 352         '("\\.rle$" "video/rle")
 353         '("\\.pfx$" "video/pfx")
 354         '("\\.avi$" "video/avi")
 355         '("\\.sme$" "video/sme")
 356         '("\\.rpza$" "video/prza")
 357         '("\\.dl$" "video/dl")
 358         '("\\.qt$" "video/qt")
 359         '("\\.rsrc$" "video/rsrc")
 360         '("\\..*$" "unknown/unknown")))
 361
 362 ;; Various variables users may set
 363
 364 (defvar gnus-uu-tmp-dir "/tmp/"
 365   "Variable saying where gnus-uu is to do its work.
 366 Default is \"/tmp/\".")
 367
 368 (defvar gnus-uu-do-not-unpack-archives nil
 369   "Non-nil means that gnus-uu won't peek inside archives looking for files to dispay.
 370 Default is nil.")
 371
 372 (defvar gnus-uu-view-and-save nil
 373   "Non-nil means that the user will always be asked to save a file after viewing it.
 374 If the variable is nil, the suer will only be asked to save if the
 375 viewing is unsuccessful. Default is nil.")
 376
 377 (defvar gnus-uu-asynchronous nil
 378   "Non-nil means that files will be viewed asynchronously.
 379 Default is nil.")
 380
 381 (defvar gnus-uu-ask-before-view nil
 382   "Non-nil means that gnus-uu will ask you before viewing each file.
 383 Especially useful when `gnus-uu-asynchronous' is set. Default is
 384 nil.")
 385
 386 (defvar gnus-uu-ignore-default-view-rules nil
 387   "Non-nil means that gnus-uu will ignore the default viewing rules.
 388 Only the user viewing rules will be consulted. Default is nil.")
 389
 390 (defvar gnus-uu-ignore-default-archive-rules nil
 391   "Non-nil means that gnus-uu will ignore the default archive unpacking commands.
 392 Only the user unpacking commands will be consulted. Default is nil.")
 393
 394 (defvar gnus-uu-kill-carriage-return t
 395   "Non-nil means that gnus-uu will strip all carriage returns from articles.
 396 Default is t.")
 397
 398 (defvar gnus-uu-view-with-metamail nil
 399   "Non-nil means that files will be viewed with metamail.
 400 The gnus-uu viewing functions will be ignored and gnus-uu will try
 401 to guess at a content-type based on file name suffixes. Default
 402 it nil.")
 403
 404 (defvar gnus-uu-unmark-articles-not-decoded nil
 405   "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
 406 Default is nil.")
 407
 408 (defvar gnus-uu-output-window-height 20
 409   "This variable says how tall the output buffer window is to be when using interactive view mode.
 410 Change it at your convenience. Default is 20.")
 411
 412 (defvar gnus-uu-correct-stripped-uucode nil
 413   "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had traling spaces deleted.
 414 Default is nil.")
 415
 416 (defvar gnus-uu-use-interactive-view nil
 417   "Non-nil means that gnus-uu will use interactive viewing mode.
 418 Gnus-uu will create a special buffer where the user may choose
 419 interactively which files to view and how. Default is nil.")
 420
 421 (defvar gnus-uu-save-in-digest nil
 422   "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
 423 If this variable is nil, gnus-uu will just save everything in a
 424 file without any embellishments. The digesting almost conforms to RFC1153 -
 425 no easy way to specify any meaningful volume and issue numbers were found,
 426 so I simply dropped them.")
 427
 428 (defvar gnus-uu-save-separate-articles nil
 429   "Non-nil means that gnus-uu will save artilces in separate files.")
 430
 431
 432 ;; Internal variables
 433
 434 (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
 435 (defconst gnus-uu-end-string "^end[ \t]*$")
 436
 437 (defconst gnus-uu-body-line "^M")
 438 (let ((i 61))
 439   (while (> (setq i (1- i)) 0)
 440     (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
 441   (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
 442
 443 ;"^M.............................................................?$"
 444
 445 (defconst gnus-uu-shar-begin-string "^#! */bin/sh")
 446
 447 (defvar gnus-uu-shar-file-name nil)
 448 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
 449
 450 (defvar gnus-uu-file-name nil)
 451 (defvar gnus-uu-list-of-files-decoded nil)
 452 (defconst gnus-uu-uudecode-process nil)
 453
 454 (defvar gnus-uu-interactive-file-list nil)
 455 (defvar gnus-uu-generated-file-list nil)
 456 (defvar gnus-uu-work-dir nil)
 457
 458 (defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*")
 459 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
 460
 461 (defconst gnus-uu-highest-article-number 1)
 462
 463 ;; Interactive functions
 464
 465 ;; UUdecode and view
 466
 467 (defun gnus-uu-decode-and-view ()
 468   "UUdecodes and 'views' (if possible) the resulting file.
 469 'Viewing' can be any action at all, as defined in the
 470 `gnus-uu-file-action-list' variable. Running 'xv' on gifs and 'cat
 471 >/dev/audio' on au files are popular actions. If the file can't be
 472 viewed, the user is asked if she would like to save the file instead."
 473   (interactive)
 474   (gnus-uu-decode-and-view-or-save t nil))
 475
 476 (defun gnus-uu-decode-and-save ()
 477   "Decodes and saves the resulting file."
 478   (interactive)
 479   (gnus-uu-decode-and-view-or-save nil nil))
 480
 481 (defun gnus-uu-marked-decode-and-view ()
 482   "Decodes and views articles marked.
 483 The marked equivalent to `gnus-uu-decode-and-view'."
 484   (interactive)
 485   (gnus-uu-decode-and-view-or-save t t))
 486
 487 (defun gnus-uu-marked-decode-and-save ()
 488   "Decodes and saves articles marked.
 489 The marked equivalent to `gnus-uu-decode-and-save'."
 490   (interactive)
 491   (gnus-uu-decode-and-view-or-save nil t))
 492
 493
 494 ;; Unshar and view
 495
 496 (defun gnus-uu-shar-and-view ()
 497   "Unshars and views articles.
 498 The shar equivalent of `gnus-uu-decode-and-view'."
 499   (interactive)
 500   (gnus-uu-unshar-and-view-or-save t nil))
 501
 502 (defun gnus-uu-shar-and-save ()
 503   "Unshars and saves files.
 504 The shar equivalent to `gnus-uu-decode-and-save'."
 505   (interactive)
 506   (gnus-uu-unshar-and-view-or-save nil nil))
 507
 508 (defun gnus-uu-marked-shar-and-view ()
 509   "Unshars and views articles marked.
 510 The marked equivalent to `gnus-uu-shar-and-view'."
 511   (interactive)
 512   (gnus-uu-unshar-and-view-or-save t t))
 513
 514 (defun gnus-uu-marked-shar-and-save ()
 515   "Unshars and saves articles marked.
 516 The marked equivalent to `gnus-uu-shar-and-save'."
 517   (interactive)
 518   (gnus-uu-unshar-and-view-or-save nil t))
 519
 520 ;; Threaded decode
 521
 522 (defun gnus-uu-threaded-decode-and-view ()
 523   "Decodes and saves the resulting file."
 524   (interactive)
 525   (gnus-uu-threaded-decode-and-view-or-save t))
 526
 527 (defun gnus-uu-threaded-decode-and-save ()
 528   "Decodes and saves the resulting file."
 529   (interactive)
 530   (gnus-uu-threaded-decode-and-view-or-save nil))
 531
 532 (defun gnus-uu-threaded-multi-decode-and-view ()
 533   "Decodes and saves the resulting file."
 534   (interactive)
 535   (gnus-uu-threaded-multi-decode-and-view-or-save t))
 536
 537 (defun gnus-uu-threaded-multi-decode-and-save ()
 538   "Decodes and saves the resulting file."
 539   (interactive)
 540   (gnus-uu-threaded-multi-decode-and-view-or-save nil))
 541
 542 (defun gnus-uu-threaded-decode-and-view-or-save (&optional view)
 543   (gnus-summary-unmark-all-processable)
 544   (gnus-uu-mark-thread)
 545   (gnus-uu-decode-and-view-or-save view t))
 546
 547 (defun gnus-uu-threaded-multi-decode-and-view-or-save (view)
 548   (let (type)
 549     (message "Decode type: [u]udecode, (s)har, s(a)ve, (b)inhex: ")
 550     (setq type (read-char))
 551     (if (not (or (= type ?u) (= type ?s) (= type ?b) (= type ?a)))
 552         (error "No such decoding method '%c'" type))
 553
 554     (gnus-summary-unmark-all-processable)
 555     (gnus-uu-mark-thread)
 556
 557     (if (= type ?\r) (setq type ?u))
 558     (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view t))
 559           ((= type ?s) (gnus-uu-unshar-and-view-or-save view t))
 560           ((= type ?b) (gnus-uu-binhex-and-save view t))
 561           ((= type ?a) (gnus-uu-save-articles view t))
 562           (t (error "No such decoding method: %s" type)))))
 563
 564
 565 ;; Toggle commands
 566
 567 (defun gnus-uu-toggle-asynchronous ()
 568   "This function toggles asynchronous viewing."
 569   (interactive)
 570   (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous))
 571       (message "gnus-uu will now view files asynchronously")
 572     (message "gnus-uu will now view files synchronously")))
 573
 574 (defun gnus-uu-toggle-query ()
 575   "This function toggles whether to ask before viewing or not."
 576   (interactive)
 577   (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view))
 578       (message "gnus-uu will now ask before viewing")
 579     (message "gnus-uu will now view without asking first")))
 580
 581 (defun gnus-uu-toggle-always-ask ()
 582   "This function toggles whether to always ask to save a file after viewing."
 583   (interactive)
 584   (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save))
 585       (message "gnus-uu will now ask to save the file after viewing")
 586     (message "gnus-uu will now not ask to save after successful viewing")))
 587
 588 (defun gnus-uu-toggle-interactive-view ()
 589   "This function toggles whether to use interactive view."
 590   (interactive)
 591   (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view))
 592       (message "gnus-uu will now use interactive view")
 593     (message "gnus-uu will now use non-interactive view")))
 594
 595 (defun gnus-uu-toggle-unmark-undecoded ()
 596   "This function toggles whether to unmark articles not decoded."
 597   (interactive)
 598   (if (setq gnus-uu-unmark-articles-not-decoded
 599             (not gnus-uu-unmark-articles-not-decoded))
 600       (message "gnus-uu will now unmark articles not decoded")
 601     (message "gnus-uu will now not unmark articles not decoded")))
 602
 603 (defun gnus-uu-toggle-kill-carriage-return ()
 604   "This function toggles the stripping of carriage returns from the articles."
 605   (interactive)
 606   (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return))
 607       (message "gnus-uu will now strip carriage returns")
 608     (message "gnus-uu won't strip carriage returns")))
 609
 610 (defun gnus-uu-toggle-view-with-metamail ()
 611   "This function toggles whether to view files with metamail."
 612   (interactive)
 613   (if (setq gnus-uu-view-with-metamail (not gnus-uu-view-with-metamail))
 614       (message "gnus-uu will now view with metamail")
 615     (message "gnus-uu will now view with the gnus-uu viewing functions")))
 616
 617 (defun gnus-uu-toggle-correct-stripped-uucode ()
 618   "This function toggles whether to correct stripped uucode."
 619   (interactive)
 620   (if (setq gnus-uu-correct-stripped-uucode
 621             (not gnus-uu-correct-stripped-uucode))
 622       (message "gnus-uu will now correct stripped uucode")
 623     (message "gnus-uu won't check and correct stripped uucode")))
 624
 625 (defun gnus-uu-toggle-any-variable ()
 626   "This function ask what variable the user wants to toggle."
 627   (interactive)
 628   (let (rep)
 629     (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteract, (u)nmark, (c)orrect, (m)eta")
 630     (setq rep (read-char))
 631     (if (= rep ?a)
 632         (gnus-uu-toggle-asynchronous))
 633     (if (= rep ?q)
 634         (gnus-uu-toggle-query))
 635     (if (= rep ?p)
 636         (gnus-uu-toggle-always-ask))
 637     (if (= rep ?k)
 638         (gnus-uu-toggle-kill-carriage-return))
 639     (if (= rep ?u)
 640         (gnus-uu-toggle-unmark-undecoded))
 641     (if (= rep ?c)
 642         (gnus-uu-toggle-correct-stripped-uucode))
 643     (if (= rep ?m)
 644         (gnus-uu-toggle-view-with-metamail))
 645     (if (= rep ?i)
 646         (gnus-uu-toggle-interactive-view))))
 647
 648
 649 ;; Misc interactive functions
 650
 651 (defun gnus-uu-decode-and-show-in-buffer ()
 652   "Uudecodes the current article and displays the result in a buffer.
 653 Might be useful if someone has, for instance, some text uuencoded in
 654 their sigs. (Stranger things have happened.)"
 655   (interactive)
 656   (gnus-uu-initialize)
 657   (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name))
 658         file-name)
 659     (save-excursion
 660       (and
 661        (gnus-summary-select-article)
 662        (gnus-uu-grab-articles (list gnus-current-article)
 663                               'gnus-uu-uustrip-article-as)
 664        (setq file-name (concat gnus-uu-work-dir gnus-uu-file-name))
 665        (progn
 666          (save-excursion
 667            (set-buffer uu-buffer)
 668            (erase-buffer)
 669            (insert-file-contents file-name))
 670          (set-window-buffer (get-buffer-window gnus-article-buffer)
 671                             uu-buffer)
 672          (message "Showing file %s in buffer" file-name)
 673          (delete-file file-name))))))
 674
 675 (defun gnus-uu-edit-begin-line ()
 676   "Edit the begin line of the current article."
 677   (interactive)
 678   (let ((buffer-read-only nil)
 679         begin b)
 680     (save-excursion
 681       (gnus-summary-select-article)
 682       (set-buffer gnus-article-buffer)
 683       (goto-line 1)
 684       (if (not (re-search-forward "begin " nil t))
 685           (error "No begin line in the current article")
 686         (beginning-of-line)
 687         (setq b (point))
 688         (end-of-line)
 689         (setq begin (buffer-substring b (point)))
 690         (setq begin (read-string "" begin))
 691         (setq buffer-read-only nil)
 692         (delete-region b (point))
 693         (insert-string begin)))))
 694
 695
 696 ;; Multi functions
 697
 698 (defun gnus-uu-multi-decode-and-view ()
 699   "Choose a method of decoding and then decode and view.
 700 This function lets the user decide what method to use for decoding.
 701 Other than that, it's equivalent to the other decode-and-view
 702 functions."
 703   (interactive)
 704   (gnus-uu-multi-decode-and-view-or-save t nil))
 705
 706 (defun gnus-uu-multi-decode-and-save ()
 707   "Choose a method of decoding and then decode and save.
 708 This function lets the user decide what method to use for decoding.
 709 Other than that, it's equivalent to the other decode-and-save
 710 functions."
 711   (interactive)
 712   (gnus-uu-multi-decode-and-view-or-save nil nil))
 713
 714 (defun gnus-uu-marked-multi-decode-and-view ()
 715   "Choose a method of decoding and then decode and view the marked articles.
 716 This function lets the user decide what method to use for decoding.
 717 Other than that, it's equivalent to the other marked decode-and-view
 718 functions."
 719   (interactive)
 720   (gnus-uu-multi-decode-and-view-or-save t t))
 721
 722 (defun gnus-uu-marked-multi-decode-and-save ()
 723   "Choose a method of decoding and then decode and save the marked articles.
 724 This function lets the user decide what method to use for decoding.
 725 Other than that, it's equivalent to the other marked decode-and-save
 726 functions."
 727   (interactive)
 728   (gnus-uu-multi-decode-and-view-or-save nil t))
 729
 730 (defun gnus-uu-multi-decode-and-view-or-save (view marked)
 731   (let (type)
 732     (message "[u]udecode, (s)har, s(a)ve, (b)inhex: ")
 733     (setq type (read-char))
 734     (if (= type ?\r) (setq type ?u))
 735     (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view marked))
 736           ((= type ?s) (gnus-uu-unshar-and-view-or-save view marked))
 737           ((= type ?b) (gnus-uu-binhex-and-save view marked))
 738           ((= type ?a) (gnus-uu-save-articles view marked))
 739           (t (error "Unknown decode method '%c'." type)))))
 740
 741
 742 ;; "All articles" commands
 743
 744 (defconst gnus-uu-rest-of-articles nil)
 745 (defvar gnus-uu-current-save-dir nil)
 746
 747 (defun gnus-uu-decode-and-view-all-articles (arg)
 748   "Try to decode all articles and view the result.
 749 ARG delimits the number of files to be decoded."
 750   (interactive "p")
 751   (gnus-uu-decode-and-view-or-save-all-articles arg nil t))
 752
 753 (defun gnus-uu-decode-and-view-all-unread-articles (arg)
 754   "Try to decode all unread articles and view the result.
 755 ARG delimits the number of files to be decoded."
 756   (interactive "p")
 757   (gnus-uu-decode-and-view-or-save-all-articles arg t t))
 758
 759 (defun gnus-uu-decode-and-save-all-unread-articles (arg)
 760   "Try to decode all unread articles and saves the result.
 761 This function reads all unread articles in the current group and sees
 762 whether it can uudecode the articles. The user will be prompted for an
 763 directory to put the resulting (if any) files.
 764 ARG delimits the number of files to be decoded."
 765   (interactive "p")
 766   (gnus-uu-decode-and-view-or-save-all-articles arg t nil))
 767
 768 (defun gnus-uu-decode-and-save-all-articles (arg)
 769   "Try to decode all articles and saves the result.
 770 Does the same as `gnus-uu-decode-and-save-all-unread-articles', except
 771 that it grabs all articles visible, unread or not.
 772 ARG delimits the number of files to be decoded."
 773   (interactive "p")
 774   (gnus-uu-decode-and-view-or-save-all-articles arg nil nil))
 775
 776 (defun gnus-uu-decode-and-view-or-save-all-articles
 777   (limit &optional unread view article-list)
 778   (gnus-uu-initialize)
 779   (let ((artreg (if unread "^[ -]" "^."))
 780         dir list-for-file result-files)
 781
 782     (if article-list
 783         ()
 784       (gnus-summary-mark-as-read gnus-current-article ? )
 785       (goto-char 1)
 786       (while (re-search-forward artreg nil t)
 787         (setq article-list
 788               (cons (gnus-summary-article-number) article-list)))
 789       (setq article-list (nreverse article-list))
 790       (gnus-summary-mark-as-read gnus-current-article ?D))
 791
 792     (if (not article-list)
 793         (error "No %sarticles in this newsgroup" (if unread "unread " "")))
 794     (if (not view)
 795         (setq dir (gnus-uu-read-directory "Where do you want the files? ")))
 796
 797     (if (= 1 limit) (setq limit (1+ (length article-list))))
 798
 799     (while (and article-list (> limit 0))
 800       (setq limit (1- limit))
 801       (gnus-summary-goto-article (car article-list))
 802       (setq list-for-file (gnus-uu-get-list-of-articles))
 803       (let ((lft list-for-file))
 804         (while lft
 805           (setq article-list (delq (car lft) article-list))
 806           (setq gnus-newsgroup-processable (delq (car lft)
 807                                                  gnus-newsgroup-processable))
 808           (setq lft (cdr lft))))
 809       (setq result-files
 810             (append
 811              (gnus-uu-grab-articles list-for-file
 812                                     'gnus-uu-uustrip-article-as t nil t)
 813              result-files)))
 814
 815     (setq gnus-uu-list-of-files-decoded result-files)
 816
 817     (if (not result-files)
 818         (error "No files after decoding"))
 819
 820     (if view
 821         (gnus-uu-view-directory gnus-uu-work-dir gnus-uu-use-interactive-view)
 822       (gnus-uu-save-directory gnus-uu-work-dir dir dir)
 823       (message "Saved.")
 824       (gnus-uu-check-for-generated-files))
 825
 826     (gnus-uu-summary-next-subject)
 827
 828     (if (and gnus-uu-use-interactive-view view)
 829         (gnus-uu-do-interactive))
 830
 831     (if (or (not view) (not gnus-uu-use-interactive-view))
 832         (gnus-uu-clean-up))))
 833
 834 (defun gnus-uu-decode-and-view-all-marked-files ()
 835   "This function will decode and view all files that have had one or more articles in its series marked.
 836 For instance, if you have marked part 2 of one series, and part 9 of
 837 another, this function will decode both series of articles. In other
 838 words, you can walk around the summary buffer and mark what series you
 839 want to see, and then using this function to decode all the files you
 840 are interested in, without worrying exactly what articles belong to
 841 what files."
 842   (interactive)
 843   (if (not gnus-newsgroup-processable)
 844       (error "No articles marked for decoding"))
 845   (gnus-uu-decode-and-view-or-save-all-articles
 846    1 nil t (setq gnus-newsgroup-processable
 847                  (nreverse gnus-newsgroup-processable))))
 848
 849 (defun gnus-uu-decode-and-save-all-marked-files ()
 850   "This function will decode and save all files that have had one or more articles in its series marked.
 851 For instance, if you have marked part 2 of one series, and part 9 of
 852 another, this function will decode both series of articles. In other
 853 words, you can walk around the summary buffer and mark what series you
 854 want to save, and then using this function to decode all the files you
 855 are interested in, without worrying exactly what articles belong to
 856 what files."
 857   (interactive)
 858   (if (not gnus-newsgroup-processable)
 859       (error "No articles marked for decoding"))
 860   (gnus-uu-decode-and-view-or-save-all-articles
 861    1 nil nil (setq gnus-newsgroup-processable
 862                    (nreverse gnus-newsgroup-processable))))
 863
 864
 865 ;; Work functions
 866
 867 ; All the interactive uudecode/view/save/marked functions are interfaces
 868 ; to this function, which does the rest.
 869 (defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir limit)
 870   (gnus-uu-initialize)
 871   (save-excursion
 872     (if (gnus-uu-decode-and-strip nil marked limit)
 873         (progn
 874           (if view
 875               (gnus-uu-view-directory gnus-uu-work-dir
 876                                       gnus-uu-use-interactive-view)
 877             (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir)
 878             (gnus-uu-check-for-generated-files)))))
 879
 880   (gnus-uu-summary-next-subject)
 881
 882   (if (and gnus-uu-use-interactive-view view)
 883       (gnus-uu-do-interactive))
 884
 885   (if (or (not view) (not gnus-uu-use-interactive-view))
 886       (gnus-uu-clean-up)))
 887
 888 ; Unshars and views/saves marked/unmarked articles.
 889 (defun gnus-uu-unshar-and-view-or-save (view marked &optional save-dir)
 890   (gnus-uu-initialize)
 891   (let (tar-file files)
 892     (save-excursion
 893       (gnus-uu-decode-and-strip t marked)
 894       (if (setq gnus-uu-list-of-files-decoded
 895                (gnus-uu-directory-files gnus-uu-work-dir t))
 896           (progn
 897             (gnus-uu-add-file gnus-uu-list-of-files-decoded)
 898             (if view
 899                 (gnus-uu-view-directory gnus-uu-work-dir
 900                                         gnus-uu-use-interactive-view)
 901               (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir)
 902               (gnus-uu-check-for-generated-files)))))
 903
 904     (gnus-uu-summary-next-subject)
 905
 906     (if (and gnus-uu-use-interactive-view view)
 907         (gnus-uu-do-interactive))
 908
 909     (if (or (not view) (not gnus-uu-use-interactive-view))
 910         (gnus-uu-clean-up))))
 911
 912
 913 ;; Functions for saving and possibly digesting articles without
 914 ;; any decoding.
 915
 916 (defconst gnus-uu-saved-article-name nil)
 917
 918 ; VIEW isn't used, but is here anyway, to provide similar interface to
 919 ; the other related functions.  If MARKED is non-nil, the list of
 920 ; marked articles is used.  If NO-SAVE is non-nil, the articles aren't
 921 ; actually saved in a permanent location, but the collecting is done
 922 ; and a temporary file with the result is returned.
 923 (defun gnus-uu-save-articles (view marked &optional no-save)
 924   (let (list-of-articles)
 925     (save-excursion
 926       (gnus-uu-initialize)
 927       (if (not marked)
 928           (setq list-of-articles (gnus-uu-get-list-of-articles))
 929         (setq list-of-articles (setq gnus-newsgroup-processable
 930                                      (nreverse gnus-newsgroup-processable)))
 931         (gnus-summary-unmark-all-processable))
 932
 933       (if (not list-of-articles)
 934           (error "No list of articles"))
 935
 936       (if gnus-uu-save-separate-articles
 937           (progn
 938             (setq gnus-uu-saved-article-name
 939                   (gnus-uu-read-directory
 940                    (concat "Where do you want the files? "))))
 941
 942         (setq gnus-uu-saved-article-name
 943               (concat gnus-uu-work-dir
 944                       (if no-save
 945                           gnus-newsgroup-name
 946                         (read-file-name "Enter file name: " gnus-newsgroup-name
 947                                         gnus-newsgroup-name))))
 948         (gnus-uu-add-file gnus-uu-saved-article-name))
 949
 950       (if (and (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article t)
 951                (not no-save) (not gnus-uu-save-separate-articles))
 952           (gnus-uu-save-file gnus-uu-saved-article-name)
 953         gnus-uu-saved-article-name))))
 954
 955 ; Function called by gnus-uu-grab-articles to treat each article.
 956 (defun gnus-uu-save-article (buffer in-state)
 957   (cond
 958    (gnus-uu-save-separate-articles
 959     (save-excursion
 960       (set-buffer buffer)
 961       (write-region 1 (point-max) (concat gnus-uu-saved-article-name
 962                                           gnus-current-article))
 963       (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
 964             ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end))
 965             ((eq in-state 'last) (list 'end))
 966             (t (list 'middle)))))
 967    ((not gnus-uu-save-in-digest)
 968     (save-excursion
 969       (set-buffer buffer)
 970       (write-region 1 (point-max) gnus-uu-saved-article-name t)
 971       (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
 972             ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end))
 973             ((eq in-state 'last) (list 'end))
 974             (t (list 'middle)))))
 975     (t
 976      (let (beg subj name headers headline sorthead body end-string state)
 977        (string-match "/\\([^/]*\\)$" gnus-uu-saved-article-name)
 978        (setq name (substring gnus-uu-saved-article-name (match-beginning 1)
 979                              (match-end 1)))
 980        (if (or (eq in-state 'first)
 981                (eq in-state 'first-and-last))
 982            (progn
 983              (setq state (list 'begin))
 984              (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
 985                              (erase-buffer))
 986              (save-excursion
 987                (set-buffer (get-buffer-create "*gnus-uu-pre*"))
 988                (erase-buffer)
 989                (insert (format
 990                         "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
 991                         (current-time-string) name name))))
 992          (if (not (eq in-state 'end))
 993              (setq state (list 'middle))))
 994        (save-excursion
 995          (set-buffer (get-buffer "*gnus-uu-body*"))
 996          (goto-char (setq beg (point-max)))
 997          (save-excursion
 998            (save-restriction
 999              (set-buffer buffer)
1000              (goto-char 1)
1001              (re-search-forward "\n\n")
1002              (setq body (buffer-substring (1- (point)) (point-max)))
1003              (narrow-to-region 1 (point))
1004              (setq headers (list "Date:" "From:" "To:" "Cc:" "Subject:"
1005                                  "Message-ID:" "Keywords:" "Summary:"))
1006              (while headers
1007                (setq headline (car headers))
1008                (setq headers (cdr headers))
1009                (goto-char 1)
1010                (if (re-search-forward (concat "^" headline ".*$") nil t)
1011                    (setq sorthead
1012                          (concat sorthead (buffer-substring
1013                                            (match-beginning 0)
1014                                            (match-end 0)) "\n"))))
1015              (widen)))
1016          (insert sorthead)(goto-char (point-max))
1017          (insert body)(goto-char (point-max))
1018          (insert (concat "\n" (make-string 30 ?-) "\n\n"))
1019          (goto-char beg)
1020          (if (re-search-forward "^Subject: \\(.*\\)$" nil t)
1021              (progn
1022                (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
1023                (save-excursion
1024                 (set-buffer (get-buffer "*gnus-uu-pre*"))
1025                 (insert (format "   %s\n" subj))))))
1026       (if (or (eq in-state 'last)
1027               (eq in-state 'first-and-last))
1028           (progn
1029             (save-excursion
1030               (set-buffer (get-buffer "*gnus-uu-pre*"))
1031               (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
1032               (write-region 1 (point-max) gnus-uu-saved-article-name))
1033             (save-excursion
1034               (set-buffer (get-buffer "*gnus-uu-body*"))
1035               (goto-char (point-max))
1036               (insert
1037                (concat (setq end-string (format "End of %s Digest" name))
1038                        "\n"))
1039               (insert (concat (make-string (length end-string) ?*) "\n"))
1040               (write-region 1 (point-max) gnus-uu-saved-article-name t))
1041             (kill-buffer (get-buffer "*gnus-uu-pre*"))
1042             (kill-buffer (get-buffer "*gnus-uu-body*"))
1043             (setq state (cons 'end state))))
1044       (if (memq 'begin state)
1045           (cons gnus-uu-saved-article-name state)
1046         state)))))
1047
1048 ;; Digest and forward articles
1049
1050 (defun gnus-uu-digest-and-forward (&optional marked)
1051   "Digests and forwards all articles in this series."
1052   (interactive)
1053   (let ((gnus-uu-save-in-digest t)
1054         file buf)
1055     (setq file (gnus-uu-save-articles nil marked t))
1056     (switch-to-buffer (setq buf (get-buffer-create "*gnus-uu-forward*")))
1057     (erase-buffer)
1058     (delete-other-windows)
1059     (erase-buffer)
1060     (insert-file file)
1061     (goto-char 1)
1062     (bury-buffer buf)
1063     (funcall gnus-mail-forward-method)))
1064
1065 (defun gnus-uu-marked-digest-and-forward (&optional marked)
1066   "Digests and forwards all marked articles."
1067   (interactive)
1068   (gnus-uu-digest-and-forward t))
1069
1070
1071 ;; Binhex treatment - not very advanced.
1072
1073 (defconst gnus-uu-binhex-body-line
1074   "^[^:]...............................................................$")
1075 (defconst gnus-uu-binhex-begin-line
1076   "^:...............................................................$")
1077 (defconst gnus-uu-binhex-end-line
1078   ":$")
1079 (defvar gnus-uu-binhex-article-name nil)
1080
1081 ; This just concatenates and strips stuff from binhexed articles.
1082 ; No actual unbinhexing takes place. VIEW is ignored.
1083 (defun gnus-uu-binhex-and-save (view marked)
1084   (gnus-uu-initialize)
1085   (let (list-of-articles)
1086     (save-excursion
1087       (if (not marked)
1088           (setq list-of-articles (gnus-uu-get-list-of-articles))
1089         (setq list-of-articles
1090               (setq gnus-newsgroup-processable
1091                     (nreverse gnus-newsgroup-processable)))
1092         (gnus-summary-unmark-all-processable))
1093       (if (not list-of-articles)
1094           (error "No list of articles"))
1095
1096       (setq gnus-uu-binhex-article-name
1097             (concat gnus-uu-work-dir
1098                     (read-file-name "Enter binhex file name: "
1099                                     gnus-newsgroup-name
1100                                     gnus-newsgroup-name)))
1101       (gnus-uu-add-file gnus-uu-binhex-article-name)
1102       (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article t)
1103           (gnus-uu-save-file gnus-uu-binhex-article-name))))
1104   (gnus-uu-check-for-generated-files)
1105   (gnus-uu-summary-next-subject))
1106
1107 (defun gnus-uu-binhex-article (buffer in-state)
1108   (let (state start-char)
1109     (save-excursion
1110       (set-buffer buffer)
1111       (widen)
1112       (goto-char 1)
1113       (if (not (re-search-forward gnus-uu-binhex-begin-line nil t))
1114           (if (not (re-search-forward gnus-uu-binhex-body-line nil t))
1115               (setq state (list 'wrong-type))))
1116
1117       (if (memq 'wrong-type state)
1118           ()
1119         (beginning-of-line)
1120         (setq start-char (point))
1121         (if (looking-at gnus-uu-binhex-begin-line)
1122             (progn
1123               (setq state (list 'begin))
1124               (write-region 1 1 gnus-uu-binhex-article-name))
1125           (setq state (list 'middle)))
1126         (goto-char (point-max))
1127         (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
1128                                     gnus-uu-binhex-end-line) nil t)
1129         (if (looking-at gnus-uu-binhex-end-line)
1130             (setq state (if (memq 'begin state)
1131                             (cons 'end state)
1132                           (list 'end))))
1133         (beginning-of-line)
1134         (forward-line 1)
1135         (if (file-exists-p gnus-uu-binhex-article-name)
1136             (append-to-file start-char (point) gnus-uu-binhex-article-name))))
1137     (if (memq 'begin state)
1138         (cons gnus-uu-binhex-article-name state)
1139       state)))
1140
1141
1142 ;; Internal view commands
1143
1144 ; This function takes two parameters. The first is name of the file to
1145 ; be viewed. `gnus-uu-view-file' will look for an action associated
1146 ; with the file type of the file. If it finds an appropriate action,
1147 ; the file will be attempted displayed.
1148 ;
1149 ; The second parameter specifies if the user is to be asked whether to
1150 ; save the file if viewing is unsuccessful. t means "do not ask."
1151 ;
1152 ; Note that the file given will be deleted by this function, one way
1153 ; or another. If `gnus-uu-asynchronous' is set, it won't be deleted
1154 ; right away, but sometime later. If the user is offered to save the
1155 ; file, it'll be moved to wherever the user wants it.
1156
1157 ; `gnus-uu-view-file' returns t if viewing is successful.
1158
1159 (defun gnus-uu-view-file (file &optional silent)
1160   (let (action did-view)
1161     (cond
1162      ((not (setq action (gnus-uu-get-action file)))
1163       (if (and (not silent) (not gnus-uu-use-interactive-view))
1164           (progn
1165             (message "Couldn't find any rule for file '%s'" file)
1166             (sleep-for 2)
1167             (gnus-uu-ask-to-save-file file))))
1168
1169      ((and gnus-uu-use-interactive-view
1170            (not (string= (or action "") "gnus-uu-archive")))
1171       (gnus-uu-enter-interactive-file (or action "") file))
1172
1173      (gnus-uu-ask-before-view
1174       (if (y-or-n-p (format "Do you want to view %s? " file))
1175           (setq did-view (gnus-uu-call-file-action file action)))
1176       (message ""))
1177
1178      ((setq did-view (gnus-uu-call-file-action file action)))
1179
1180      ((not silent)
1181       (gnus-uu-ask-to-save-file file)))
1182
1183     (if (and (file-exists-p file)
1184              (not gnus-uu-use-interactive-view)
1185              (or
1186               (not (and gnus-uu-asynchronous did-view))
1187               (string= (or action  "") "gnus-uu-archive")))
1188         (delete-file file))
1189
1190   did-view))
1191
1192 (defun gnus-uu-call-file-action (file action)
1193   (prog1
1194       (if gnus-uu-asynchronous
1195           (gnus-uu-call-asynchronous file action)
1196         (gnus-uu-call-synchronous file action))
1197     (if gnus-uu-view-and-save
1198         (gnus-uu-ask-to-save-file file))))
1199
1200 (defun gnus-uu-ask-to-save-file (file)
1201   (if (y-or-n-p (format "Do you want to save the file %s? " file))
1202       (gnus-uu-save-file file))
1203   (message ""))
1204
1205 (defun gnus-uu-get-action (file-name)
1206   (let (action)
1207     (setq action
1208           (gnus-uu-choose-action
1209            file-name
1210            (append
1211             (if (and gnus-uu-use-interactive-view
1212                      gnus-uu-user-interactive-view-rules)
1213                 gnus-uu-user-interactive-view-rules
1214               gnus-uu-user-view-rules)
1215             (if (or gnus-uu-ignore-default-view-rules
1216                     (not gnus-uu-use-interactive-view))
1217                 ()
1218               gnus-uu-default-interactive-view-rules-begin)
1219             (if gnus-uu-ignore-default-view-rules
1220                 nil
1221               gnus-uu-default-view-rules)
1222             (if gnus-uu-use-interactive-view
1223                 (append gnus-uu-user-interactive-view-rules-end
1224                         (if gnus-uu-ignore-default-view-rules
1225                             ()
1226                           gnus-uu-default-interactive-view-rules-end))
1227               gnus-uu-user-view-rules-end))))
1228     (if (and (not (string= (or action "") "gnus-uu-archive"))
1229              gnus-uu-view-with-metamail)
1230         (if (setq action
1231                   (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
1232             (setq action (format "metamail -d -b -c \"%s\"" action))))
1233     action))
1234
1235 ; `gnus-uu-call-synchronous' takes two parameters: The name of the
1236 ; file to be displayed and the command to display it with. Returns t
1237 ; on success and nil if the file couldn't be displayed.
1238 (defun gnus-uu-call-synchronous (file-name action)
1239   (let (did-view command)
1240     (save-excursion
1241       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1242       (erase-buffer)
1243       (setq command (gnus-uu-command action file-name))
1244       (message "Viewing with '%s'" command)
1245       (if (not (= 0 (call-process "sh" nil t nil "-c" command)))
1246           (progn
1247             (goto-char 1)
1248             (while (re-search-forward "\n" nil t)
1249               (replace-match " "))
1250             (message (concat "Error: " (buffer-substring 1 (point-max))))
1251             (sit-for 2))
1252         (message "")
1253         (setq did-view t)))
1254     did-view))
1255
1256 ; `gnus-uu-call-asyncronous' takes two parameters: The name of the
1257 ; file to be displayed and the command to display it with. Since the
1258 ; view command is executed asynchronously, it's kinda hard to decide
1259 ; whether the command succeded or not, so this function always returns
1260 ; t. It also adds "; rm -f file-name" to the end of the execution
1261 ; string, so the file will be removed after viewing has ended.
1262 (defun gnus-uu-call-asynchronous (file-name action)
1263   (let (command file tmp-file start)
1264     (while (string-match "/" file-name start)
1265       (setq start (1+ (match-beginning 0))))
1266     (setq file (substring file-name start))
1267     (setq tmp-file (concat gnus-uu-work-dir file))
1268     (if (string= tmp-file file-name)
1269         ()
1270       (rename-file file-name tmp-file t)
1271       (setq file-name tmp-file))
1272
1273     (setq command (gnus-uu-command action file-name))
1274     (setq command (format "%s ; rm -f %s" command file-name))
1275     (message "Viewing with %s" command)
1276     (start-process "gnus-uu-view" nil "sh" "-c" command)
1277     t))
1278
1279 ; `gnus-uu-decode-and-strip' does all the main work. It finds out what
1280 ; articles to grab, grabs them, strips the result and decodes. If any
1281 ; of these operations fail, it returns nil, t otherwise.  If shar is
1282 ; t, it will pass this on to `gnus-uu-grab-articles', which will
1283 ; (probably) unshar the articles. If use-marked is non-nil, it won't
1284 ; try to find articles, but use the marked list.
1285 (defun gnus-uu-decode-and-strip (&optional shar use-marked limit)
1286   (let (list-of-articles)
1287     (save-excursion
1288
1289       (if use-marked
1290           (if (not gnus-newsgroup-processable)
1291               (message "No articles marked")
1292             (setq list-of-articles
1293                   (setq gnus-newsgroup-processable
1294                         (nreverse gnus-newsgroup-processable)))
1295             (gnus-summary-unmark-all-processable))
1296         (setq list-of-articles (gnus-uu-get-list-of-articles)))
1297
1298       (and list-of-articles
1299            (gnus-uu-grab-articles
1300             list-of-articles
1301             (if shar 'gnus-uu-unshar-article 'gnus-uu-uustrip-article-as)
1302             t limit)))))
1303
1304 ; Takes a string and puts a \ in front of every special character;
1305 ; ignores any leading "version numbers" thingies that they use in the
1306 ; comp.binaries groups, and either replaces anything that looks like
1307 ; "2/3" with "[0-9]+/[0-9]+" or, if it can't find something like that,
1308 ; replaces the last two numbers with "[0-9]+". This, in my experience,
1309 ; should get most postings of a series.
1310 (defun gnus-uu-reginize-string (string)
1311   (let ((count 2)
1312         (vernum "v[0-9]+[a-z][0-9]+:")
1313         reg beg)
1314     (save-excursion
1315       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1316       (buffer-disable-undo (current-buffer))
1317       (erase-buffer)
1318       (insert (regexp-quote string))
1319       (setq beg 1)
1320
1321       (setq case-fold-search nil)
1322       (goto-char 1)
1323       (if (looking-at vernum)
1324           (progn
1325             (replace-match vernum t t)
1326             (setq beg (length vernum))))
1327
1328       (goto-char beg)
1329       (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
1330           (replace-match " [0-9]+/[0-9]+")
1331
1332         (goto-char beg)
1333         (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
1334             (replace-match "[0-9]+ of [0-9]+")
1335
1336           (end-of-line)
1337           (while (and (re-search-backward "[0-9]" nil t) (> count 0))
1338             (while (and
1339                     (looking-at "[0-9]")
1340                     (< 1 (goto-char (1- (point))))))
1341             (re-search-forward "[0-9]+" nil t)
1342             (replace-match "[0-9]+")
1343             (backward-char 5)
1344             (setq count (1- count)))))
1345
1346       (goto-char beg)
1347       (while (re-search-forward "[ \t]+" nil t)
1348         (replace-match "[ \t]*" t t))
1349
1350       (buffer-substring 1 (point-max)))))
1351
1352 (defsubst gnus-uu-string< (l1 l2)
1353   (string< (car l1) (car l2)))
1354
1355 ; Finds all articles that matches the regular expression given.
1356 ; Returns the resulting list. SUBJECT is the regular expression to be
1357 ; matched. If it is nil, the current article name will be used. If
1358 ; MARK-ARTICLES is non-nil, articles found are marked. If ONLY-UNREAD
1359 ; is non-nil, only unread articles are chose. If DO-NOT-TRANSLATE is
1360 ; non-nil, article names are not equialized before sorting.
1361 (defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread do-not-translate)
1362   (let (beg end reg-subject list-of-subjects list-of-numbers art-num)
1363     (save-excursion
1364
1365 ; If the subject is not given, this function looks at the current subject
1366 ; and takes that.
1367
1368       (if subject
1369           (setq reg-subject subject)
1370         (setq reg-subject
1371               (format "%s [-0-9]+ %s [-0-9]+ [-0-9]+[\n\r]"
1372                (gnus-uu-reginize-string (gnus-summary-subject-string))
1373                (if only-unread "[- ]" "."))))
1374
1375       (if reg-subject
1376           (progn
1377
1378 ; Collect all subjects matching reg-subject.
1379
1380             (let ((case-fold-search t))
1381               (goto-char 1)
1382               (while (re-search-forward reg-subject nil t)
1383                 (progn
1384                   (goto-char (match-beginning 0))
1385                   (setq list-of-subjects
1386                         (cons (cons (gnus-summary-subject-string)
1387                                     (gnus-summary-article-number))
1388                               list-of-subjects))
1389                   (forward-line 1))))
1390
1391 ; Expand all numbers in all the subjects: (hi9 -> hi0009, etc).
1392
1393             (setq list-of-subjects
1394                   (gnus-uu-expand-numbers list-of-subjects
1395                                           (not do-not-translate)))
1396
1397 ; Sort the subjects.
1398
1399             (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<))
1400
1401 ; Get the article numbers from the sorted list of subjects.
1402
1403             (while list-of-subjects
1404               (setq art-num (cdr (car list-of-subjects)))
1405               (if mark-articles (gnus-summary-mark-as-read art-num ?#))
1406               (setq list-of-numbers (cons art-num list-of-numbers))
1407               (setq list-of-subjects (cdr list-of-subjects)))
1408
1409             (setq list-of-numbers (nreverse list-of-numbers))))
1410
1411       list-of-numbers)))
1412
1413 ; Takes a list of strings and "expands" all numbers in all the
1414 ; strings.  That is, this function makes all numbers equal length by
1415 ; prepending lots of zeroes before each number. This is to ease later
1416 ; sorting to find out what sequence the articles are supposed to be
1417 ; decoded in. Returns the list of expanded strings.
1418 (defun gnus-uu-expand-numbers (string-list &optional translate)
1419   (let ((out-list string-list)
1420         string pos num)
1421     (save-excursion
1422       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1423       (buffer-disable-undo (current-buffer))
1424       (while string-list
1425         (erase-buffer)
1426         (insert (car (car string-list)))
1427         ;; Translate multiple spaces to one space.
1428         (goto-char 1)
1429         (while (re-search-forward "[ \t]+" nil t)
1430           (replace-match " "))
1431         ;; Translate all characters to "a".
1432         (goto-char 1)
1433         (if translate
1434             (while (re-search-forward "[A-Za-z]" nil t)
1435               (replace-match "a" t t)))
1436         ;; Expand numbers.
1437         (goto-char 1)
1438         (while (re-search-forward "[0-9]+" nil t)
1439           (replace-match
1440            (format "%06d"
1441                    (string-to-int (buffer-substring
1442                                    (match-beginning 0) (match-end 0))))))
1443         (setq string (buffer-substring 1 (point-max)))
1444         (setcar (car string-list) string)
1445         (setq string-list (cdr string-list))))
1446     out-list))
1447
1448
1449 ;; gnus-uu-grab-article
1450 ;
1451 ; This is the general multi-article treatment function.  It takes a
1452 ; list of articles to be grabbed and a function to apply to each
1453 ; article.
1454 ;
1455 ; The function to be called should take two parameters.  The first
1456 ; parameter is the article buffer. The function should leave the
1457 ; result, if any, in this buffer. Most treatment functions will just
1458 ; generate files...
1459 ;
1460 ; The second parameter is the state of the list of articles, and can
1461 ; have four values: `first', `middle', `last' and `first-and-last'.
1462 ;
1463 ; The function should return a list. The list may contain the
1464 ; following symbols:
1465 ; `error' if an error occurred
1466 ; `begin' if the beginning of an encoded file has been received
1467 ;   If the list returned contains a `begin', the first element of
1468 ;   the list *must* be a string with the file name of the decoded
1469 ;   file.
1470 ; `end' if the the end of an encoded file has been received
1471 ; `middle' if the article was a body part of an encoded file
1472 ; `wrong-type' if the article was not a part of an encoded file
1473 ; `ok', which can be used everything is ok
1474
1475 (defvar gnus-uu-has-been-grabbed nil)
1476
1477 (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
1478   (let (art)
1479     (if (not (and gnus-uu-has-been-grabbed
1480                   gnus-uu-unmark-articles-not-decoded))
1481         ()
1482       (if dont-unmark-last-article
1483           (progn
1484             (setq art (car gnus-uu-has-been-grabbed))
1485             (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))))
1486       (while gnus-uu-has-been-grabbed
1487         (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
1488         (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
1489       (if dont-unmark-last-article
1490           (setq gnus-uu-has-been-grabbed (list art))))))
1491
1492 ; This function takes a list of articles and a function to apply to
1493 ; each article grabbed.
1494 ;
1495 ; This function returns a list of files decoded if the grabbing and
1496 ; the process-function has been successful and nil otherwise.
1497 (defun gnus-uu-grab-articles (list-of-articles process-function &optional sloppy limit no-errors)
1498   (let ((state 'first)
1499         (wrong-type t)
1500         has-been-begin has-been-end
1501         article result-file result-files process-state article-buffer)
1502
1503     (if (not (gnus-server-opened gnus-current-select-method))
1504         (progn
1505           (gnus-start-news-server)
1506           (gnus-request-group gnus-newsgroup-name)))
1507
1508     (setq gnus-uu-has-been-grabbed nil)
1509
1510     (while (and list-of-articles
1511                 (not (memq 'error process-state))
1512                 (or sloppy
1513                     (not (memq 'end process-state))))
1514
1515       (setq article (car list-of-articles))
1516       (setq list-of-articles (cdr list-of-articles))
1517       (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed))
1518
1519       (if (> article gnus-uu-highest-article-number)
1520           (setq gnus-uu-highest-article-number article))
1521
1522       (if (eq list-of-articles ())
1523           (if (eq state 'first)
1524               (setq state 'first-and-last)
1525             (setq state 'last)))
1526
1527       (message "Getting article %d" article)
1528
1529       (if (not (gnus-server-opened gnus-current-select-method))
1530           (progn
1531             (gnus-start-news-server)
1532             (gnus-request-group gnus-newsgroup-name)))
1533
1534       (if (not (= (or gnus-current-article 0) article))
1535           (progn
1536             (gnus-request-article article gnus-newsgroup-name
1537                                   nntp-server-buffer)
1538             (setq gnus-last-article gnus-current-article)
1539             (setq gnus-current-article article)
1540             (if (stringp nntp-server-buffer)
1541                 (setq article-buffer nntp-server-buffer)
1542               (setq article-buffer (buffer-name nntp-server-buffer))))
1543         (setq article-buffer gnus-article-buffer))
1544
1545       (buffer-disable-undo article-buffer)
1546       (gnus-summary-mark-as-read article)
1547
1548       (setq process-state (funcall process-function article-buffer state))
1549
1550       (if (or (memq 'begin process-state)
1551               (and (or (eq state 'first) (eq state 'first-and-last))
1552                    (memq 'ok process-state)))
1553           (progn
1554             (if has-been-begin
1555                 (if (and result-file (file-exists-p result-file))
1556                     (delete-file result-file)))
1557             (if (memq 'begin process-state)
1558                 (setq result-file (car process-state)))
1559             (setq has-been-begin t)
1560             (setq has-been-end nil)))
1561
1562       (if (memq 'end process-state)
1563           (progn
1564             (setq gnus-uu-has-been-grabbed nil)
1565             (setq result-files (cons result-file result-files))
1566             (setq has-been-end t)
1567             (setq has-been-begin nil)
1568             (if (and limit (= (length result-files) limit))
1569                 (progn
1570                   (setq list-of-articles nil)
1571                   (setq gnus-newsgroup-processable nil)))))
1572
1573       (if (and (or (eq state 'last) (eq state 'first-and-last))
1574                (not (memq 'end process-state)))
1575                 (if (and result-file (file-exists-p result-file))
1576                     (delete-file result-file)))
1577
1578       (setq result-file nil)
1579
1580       (if (not (memq 'wrong-type process-state))
1581           (setq wrong-type nil)
1582         (if gnus-uu-unmark-articles-not-decoded
1583             (gnus-summary-tick-article article t)))
1584
1585       (if sloppy (setq wrong-type nil))
1586
1587       (if (and (not has-been-begin)
1588                (not sloppy)
1589                (or (memq 'end process-state)
1590                    (memq 'middle process-state)))
1591           (progn
1592             (setq process-state (list 'error))
1593             (message "No begin part at the beginning")
1594             (sleep-for 2))
1595         (setq state 'middle)))
1596
1597     ; Make sure the last article is put in the article buffer
1598     ; & fix windows etc.
1599
1600     (if (not (string= article-buffer gnus-article-buffer))
1601         (save-excursion
1602           (set-buffer (get-buffer-create gnus-article-buffer))
1603           (let ((buffer-read-only nil))
1604             (widen)
1605             (erase-buffer)
1606             (insert-buffer-substring article-buffer)
1607             (goto-char 1))))
1608     (run-hooks 'gnus-mark-article-hook)
1609
1610     (if result-files
1611         ()
1612       (if (not has-been-begin)
1613           (if (not no-errors) (message "Wrong type file"))
1614         (if (memq 'error process-state)
1615             (setq result-files nil)
1616           (if (not (or (memq 'ok process-state)
1617                        (memq 'end process-state)))
1618               (progn
1619                 (if (not no-errors)
1620                     (message "End of articles reached before end of file"))
1621                 (setq result-files nil))
1622             (gnus-uu-unmark-list-of-grabbed)))))
1623     (setq gnus-uu-list-of-files-decoded result-files)
1624     result-files))
1625
1626 (defun gnus-uu-uudecode-sentinel (process event)
1627   (delete-process (get-process process)))
1628
1629 ; Uudecodes a file asynchronously.
1630 (defun gnus-uu-uustrip-article-as (process-buffer in-state)
1631   (let ((state (list 'ok))
1632         (process-connection-type nil)
1633         start-char pst name-beg name-end)
1634     (save-excursion
1635       (set-buffer process-buffer)
1636       (let ((case-fold-search nil)
1637             (buffer-read-only nil))
1638
1639         (goto-char 1)
1640
1641         (if gnus-uu-kill-carriage-return
1642             (progn
1643               (while (search-forward "\r" nil t)
1644                 (delete-backward-char 1))
1645               (goto-char 1)))
1646
1647         (if (not (re-search-forward gnus-uu-begin-string nil t))
1648             (if (not (re-search-forward gnus-uu-body-line nil t))
1649                 (setq state (list 'wrong-type))))
1650
1651         (if (memq 'wrong-type state)
1652             ()
1653           (beginning-of-line)
1654           (setq start-char (point))
1655
1656           (if (looking-at gnus-uu-begin-string)
1657               (progn
1658                 (setq name-end (match-end 1))
1659
1660                 ; Replace any slashes and spaces in file names before decoding
1661                 (goto-char (setq name-beg (match-beginning 1)))
1662                 (while (re-search-forward "/" name-end t)
1663                   (replace-match ","))
1664                 (goto-char name-beg)
1665                 (while (re-search-forward " " name-end t)
1666                   (replace-match "_"))
1667                 (goto-char name-beg)
1668                 (if (re-search-forward "_*$" name-end t)
1669                   (replace-match ""))
1670
1671                 (setq gnus-uu-file-name (buffer-substring name-beg name-end))
1672                 (and gnus-uu-uudecode-process
1673                      (setq pst (process-status
1674                                 (or gnus-uu-uudecode-process "nevair")))
1675                      (if (or (eq pst 'stop) (eq pst 'run))
1676                          (progn
1677                            (delete-process gnus-uu-uudecode-process)
1678                            (gnus-uu-unmark-list-of-grabbed t))))
1679                 (if (get-process "*uudecode*")
1680                     (delete-process "*uudecode*"))
1681                 (setq gnus-uu-uudecode-process
1682                       (start-process
1683                        "*uudecode*"
1684                        (get-buffer-create gnus-uu-output-buffer-name)
1685                        "sh" "-c"
1686                        (format "cd %s ; uudecode" gnus-uu-work-dir)))
1687                 (set-process-sentinel
1688                  gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
1689                 (setq state (list 'begin))
1690                 (gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name)))
1691             (setq state (list 'middle)))
1692
1693           (goto-char (point-max))
1694
1695           (re-search-backward
1696            (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t)
1697           (beginning-of-line)
1698
1699           (if (looking-at gnus-uu-end-string)
1700               (setq state (cons 'end state)))
1701           (forward-line 1)
1702
1703           (and gnus-uu-uudecode-process
1704                (setq pst (process-status
1705                           (or gnus-uu-uudecode-process "nevair")))
1706                (if (or (eq pst 'run) (eq pst 'stop))
1707                    (progn
1708                      (if gnus-uu-correct-stripped-uucode
1709                          (progn
1710                            (gnus-uu-check-correct-stripped-uucode
1711                             start-char (point))
1712                            (goto-char (point-max))
1713                            (re-search-backward
1714                             (concat gnus-uu-body-line "\\|"
1715                                     gnus-uu-end-string)
1716                             nil t)
1717                            (forward-line 1)))
1718
1719                      (condition-case err
1720                          (process-send-region gnus-uu-uudecode-process
1721                                               start-char (point))
1722                        (error
1723                         (progn
1724                           (delete-process gnus-uu-uudecode-process)
1725                           (message "gnus-uu: Couldn't uudecode")
1726 ;                         (sleep-for 2)
1727                           (setq state (list 'wrong-type)))))
1728
1729                      (if (memq 'end state)
1730                          (accept-process-output gnus-uu-uudecode-process)))
1731                  (setq state (list 'wrong-type))))
1732           (if (not gnus-uu-uudecode-process)
1733               (setq state (list 'wrong-type)))))
1734
1735       (if (memq 'begin state)
1736           (cons (concat gnus-uu-work-dir gnus-uu-file-name) state)
1737         state))))
1738
1739 ; This function is used by `gnus-uu-grab-articles' to treat
1740 ; a shared article.
1741 (defun gnus-uu-unshar-article (process-buffer in-state)
1742   (let ((state (list 'ok))
1743         start-char)
1744     (save-excursion
1745      (set-buffer process-buffer)
1746      (goto-char 1)
1747      (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
1748          (setq state (list 'wrong-type))
1749        (beginning-of-line)
1750        (setq start-char (point))
1751        (call-process-region
1752         start-char (point-max) "sh" nil
1753         (get-buffer-create gnus-uu-output-buffer-name) nil
1754         "-c" (concat "cd " gnus-uu-work-dir " ; sh"))))
1755     state))
1756
1757 ; Returns the name of what the shar file is going to unpack.
1758 (defun gnus-uu-find-name-in-shar ()
1759   (let ((oldpoint (point))
1760         res)
1761     (goto-char 1)
1762     (if (re-search-forward gnus-uu-shar-name-marker nil t)
1763         (setq res (buffer-substring (match-beginning 1) (match-end 1))))
1764     (goto-char oldpoint)
1765     res))
1766
1767 ; Returns the article number of the given subject.
1768 (defun gnus-uu-article-number (subject)
1769   (let (end)
1770     (string-match "[0-9]+[^0-9]" subject 1)
1771     (setq end (match-end 0))
1772     (string-to-int
1773      (substring subject (string-match "[0-9]" subject 1) end))))
1774
1775 ; `gnus-uu-choose-action' chooses what action to perform given the name
1776 ; and `gnus-uu-file-action-list'.  Returns either nil if no action is
1777 ; found, or the name of the command to run if such a rule is found.
1778 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
1779   (let ((action-list (copy-sequence file-action-list))
1780         rule action)
1781     (and
1782      (or no-ignore
1783          (and (not
1784                (and gnus-uu-ignore-files-by-name
1785                     (string-match gnus-uu-ignore-files-by-name file-name)))
1786               (not
1787                (and gnus-uu-ignore-files-by-type
1788                     (string-match gnus-uu-ignore-files-by-type
1789                                   (or (gnus-uu-choose-action
1790                                        file-name gnus-uu-ext-to-mime-list t)
1791                                       ""))))))
1792      (while (not (or (eq action-list ()) action))
1793        (setq rule (car action-list))
1794        (setq action-list (cdr action-list))
1795        (if (string-match (car rule) file-name)
1796            (setq action (car (cdr rule))))))
1797     action))
1798
1799 (defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing)
1800   (let (dir file-name command files file)
1801     (setq files (directory-files from-dir t))
1802     (if default-dir
1803         (setq dir default-dir)
1804       (setq dir (gnus-uu-read-directory
1805                  (concat "Where do you want the file"
1806                          (if (< 3 (length files)) "s" "") "? "))))
1807
1808     (while files
1809       (setq file (car files))
1810       (setq files (cdr files))
1811       (string-match "/[^/]*$" file)
1812       (setq file-name (substring file (1+ (match-beginning 0))))
1813       (if (string-match "^\\.\\.?$" file-name)
1814           ()
1815         (if (and (not ignore-existing) (file-exists-p (concat dir file-name)))
1816             (setq file-name
1817                   (read-file-name "File exists. Enter a new name: " dir
1818                                   (concat dir file-name) nil file-name))
1819           (setq file-name (concat dir file-name)))
1820         (rename-file file file-name t)))))
1821
1822 ; Moves the file from the tmp directory to where the user wants it.
1823 (defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing)
1824   (let (dir file-name command)
1825     (string-match "/[^/]*$" from-file-name)
1826     (setq file-name (substring from-file-name (1+ (match-beginning 0))))
1827     (if default-dir
1828         (setq dir default-dir)
1829       (setq dir (gnus-uu-read-directory "Where do you want the file? ")))
1830     (if (and (not ignore-existing) (file-exists-p (concat dir file-name)))
1831         (setq file-name
1832               (read-file-name "File exist. Enter a new name: " dir
1833                               (concat dir file-name) nil file-name))
1834       (setq file-name (concat dir file-name)))
1835     (rename-file from-file-name file-name t)))
1836
1837 (defun gnus-uu-read-directory (prompt &optional default)
1838   (let (dir ok create)
1839     (while (not ok)
1840       (setq ok t)
1841       (setq dir (if default default
1842                   (read-file-name prompt gnus-uu-current-save-dir
1843                                   gnus-uu-current-save-dir)))
1844       (while (string-match "/$" dir)
1845         (setq dir (substring dir 0 (match-beginning 0))))
1846       (if (file-exists-p dir)
1847           (if (not (file-directory-p dir))
1848               (progn
1849                 (setq ok nil)
1850                 (message "%s is a file" dir)
1851                 (sit-for 2)))
1852         (setq create ?o)
1853         (while (not (or (= create ?y) (= create ?n)))
1854           (message "%s: No such directory. Do you want to create it? (y/n)"
1855                    dir)
1856           (setq create (read-char)))
1857         (if (= create ?y) (make-directory dir))))
1858     (setq gnus-uu-current-save-dir (concat dir "/"))))
1859
1860 ; Unpacks an archive and views all the files in it. Returns t if
1861 ; viewing one or more files is successful.
1862 (defun gnus-uu-treat-archive (file-path)
1863   (let ((did-unpack t)
1864         action command files file file-name dir)
1865     (setq action (gnus-uu-choose-action
1866                   file-path (append gnus-uu-user-archive-rules
1867                                     (if gnus-uu-ignore-default-archive-rules
1868                                         nil
1869                                       gnus-uu-default-archive-rules))))
1870
1871     (if (not action) (error "No unpackers for the file %s" file-path))
1872
1873     (string-match "/[^/]*$" file-path)
1874     (setq file-name (substring file-path (1+ (match-beginning 0))))
1875     (setq dir (substring file-path 0 (match-beginning 0)))
1876
1877     (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers)
1878         (copy-file file-path (concat file-path "~") t))
1879
1880     (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
1881
1882     (save-excursion
1883       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1884       (erase-buffer))
1885
1886     (message "Unpacking: %s..." (gnus-uu-command action file-path))
1887
1888     (if (= 0 (call-process "sh" nil
1889                            (get-buffer-create gnus-uu-output-buffer-name)
1890                            nil "-c" command))
1891         (message "")
1892       (if (not gnus-uu-use-interactive-view)
1893           (progn
1894             (message "Error during unpacking of archive")
1895             (sleep-for 2)))
1896       (setq did-unpack nil))
1897
1898     (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers)
1899         (rename-file (concat file-path "~") file-path t))
1900
1901     did-unpack))
1902
1903 ; Tries to view all the files in the given directory. Returns t if
1904 ; viewing one or more files is successful.
1905 (defun gnus-uu-view-directory (dir &optional dont-delete-files not-top)
1906   (let ((first t)
1907         files file did-view ignore-files)
1908     (setq files (gnus-uu-directory-files dir t))
1909     (gnus-uu-add-file files)
1910     (setq ignore-files files)
1911
1912     (while (gnus-uu-unpack-archives
1913             files (if not-top (list ".")
1914                     (if first () ignore-files)))
1915       (setq first nil)
1916       (gnus-uu-add-file
1917        (setq files (gnus-uu-directory-files dir t))))
1918
1919     (gnus-uu-add-file (gnus-uu-directory-files dir t))
1920
1921     (while files
1922       (setq file (car files))
1923       (setq files (cdr files))
1924       (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive"))
1925           (progn
1926             (set-file-modes file 448)
1927             (if (file-directory-p file)
1928                 (setq did-view (or (gnus-uu-view-directory file
1929                                                            dont-delete-files
1930                                                            t)
1931                                    did-view))
1932               (setq did-view (or (gnus-uu-view-file file t) did-view)))))
1933       (if (and (not dont-delete-files) (not gnus-uu-asynchronous)
1934                (file-exists-p file))
1935           (delete-file file)))
1936
1937     (if (and (not gnus-uu-asynchronous) (not dont-delete-files))
1938         (if (string-match "/$" dir)
1939             (delete-directory (substring dir 0 (match-beginning 0)))
1940           (delete-directory dir)))
1941     did-view))
1942
1943 (defun gnus-uu-dir-files (dir)
1944   (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$"))
1945         files file)
1946     (while dirs
1947       (if (file-directory-p (setq file (car dirs)))
1948           (setq files (append files (gnus-uu-dir-files file)))
1949         (setq files (cons file files)))
1950       (setq dirs (cdr dirs)))
1951     files))
1952
1953 (defun gnus-uu-directory-files-old (dir)
1954   (let ((files (directory-files dir t)) f)
1955     (setq f files)
1956     (while (cdr f)
1957       (if (string-match "/\\.\\.?$" (car (cdr f)))
1958           (setcdr f (cdr (cdr f)))
1959         (setq f (cdr f))))
1960     (if (string-match "/\\.\\.?$" (car files)) (cdr files)
1961       files)))
1962
1963 (defun gnus-uu-unpack-archives (files &optional ignore)
1964   (let (path did-unpack)
1965     (while files
1966       (setq path (car files))
1967       (setq files (cdr files))
1968       (if (not (gnus-uu-string-in-list path ignore))
1969           (if (string= (or (gnus-uu-get-action
1970                             (gnus-uu-name-from-path path)) "")
1971                        "gnus-uu-archive")
1972               (progn
1973                 (if (and (not (setq did-unpack (gnus-uu-treat-archive path)))
1974                          gnus-uu-use-interactive-view)
1975                     (gnus-uu-enter-interactive-file
1976                      "# error during unpacking of" path))
1977                 (if ignore (delete-file path))))))
1978     did-unpack))
1979
1980
1981 ;; Manual marking
1982
1983 (defun gnus-uu-mark-by-regexp ()
1984   "Asks for a regular expression and marks all articles that match."
1985   (interactive)
1986   (let (exp)
1987     (setq exp (read-from-minibuffer "Mark (regexp): "))
1988     (setq gnus-newsgroup-processable
1989           (nconc gnus-newsgroup-processable
1990                   (nreverse (gnus-uu-get-list-of-articles exp t))))
1991     (message "")))
1992
1993 (defun gnus-uu-mark-region (beg end)
1994   "Marks all articles between point and mark."
1995   (interactive "r")
1996   (let ((mark-even-if-inactive t)
1997         (opoint 0)
1998         tmp)
1999     (save-excursion
2000       (cond
2001        ((= beg end)
2002         (error "Empty region."))
2003        (t
2004         (if (< end beg)
2005             (progn
2006               (setq tmp beg)
2007               (setq beg end)
2008               (setq end tmp)))
2009         (goto-char beg)
2010         (while (and (< (point) end)
2011                     (not (= (point) opoint)))
2012           (setq opoint (point))
2013           (gnus-summary-set-process-mark (gnus-summary-article-number))))))))
2014
2015 (defun gnus-uu-mark-thread ()
2016   "Marks all articles downwards in this thread."
2017   (interactive)
2018   (beginning-of-line)
2019   (let (level)
2020     (if (not (search-forward ":" nil t))
2021         ()
2022       (setq level (current-column))
2023       (gnus-summary-set-process-mark (gnus-summary-article-number))
2024       (gnus-summary-search-forward)
2025       (while (< level (current-column))
2026         (gnus-summary-set-process-mark (gnus-summary-article-number))
2027         (gnus-summary-search-forward))
2028       (gnus-summary-search-backward))))
2029
2030 (defun gnus-uu-marked-universal-argument ()
2031   "Perform any operation on all marked articles.
2032 If you type `\\<gnus-summary-mode-map>\\[gnus-uu-decode-and-view]' and then, for instance, `u',
2033 gnus-uu will perform the operation bound to `u' on all
2034 marked articles."
2035   (interactive)
2036   (let ((articles (setq gnus-newsgroup-processable
2037                         (nreverse gnus-newsgroup-processable)))
2038         key func)
2039     (gnus-summary-unmark-all-processable)
2040     (if (not articles)
2041         (error "No articles marked"))
2042     (if (not (setq func (key-binding (read-key-sequence "C-c C-v C-u"))))
2043         (error "Undefined key"))
2044     (while articles
2045       (gnus-summary-goto-subject (car articles))
2046       (command-execute func)
2047       (setq articles (cdr articles)))))
2048
2049
2050 ;; Various stuff
2051
2052 (defun gnus-uu-string-in-list (string list)
2053   (while (and list
2054               (not (string= (car list) string))
2055               (setq list (cdr list))))
2056   list)
2057
2058 (defun gnus-uu-name-from-path (path)
2059   (string-match "/[^/]*$" path)
2060   (substring path (1+ (match-beginning 0))))
2061
2062 (defun gnus-uu-directory-files (dir &optional full)
2063   (let (files out file)
2064     (setq files (directory-files dir full))
2065     (while files
2066       (setq file (car files))
2067       (setq files (cdr files))
2068       (if (not (string-match "/\\.\\.?$" file))
2069           (setq out (cons file out))))
2070     (setq out (reverse out))
2071     out))
2072
2073 (defun gnus-uu-check-correct-stripped-uucode (start end)
2074   (let (found beg length short)
2075     (if (not gnus-uu-correct-stripped-uucode)
2076         ()
2077       (goto-char start)
2078
2079       (if (re-search-forward " \\|`" end t)
2080           (progn
2081             (goto-char start)
2082             (while (not (eobp))
2083               (progn
2084                 (if (looking-at "\n") (replace-match ""))
2085                 (forward-line 1))))
2086
2087         (while (not (eobp))
2088           (if (looking-at (concat gnus-uu-begin-string "\\|"
2089                                   gnus-uu-end-string))
2090               ()
2091             (if (not found)
2092                 (progn
2093                   (beginning-of-line)
2094                   (setq beg (point))
2095                   (end-of-line)
2096                   (setq length (- (point) beg))))
2097             (setq found t)
2098             (beginning-of-line)
2099             (setq beg (point))
2100             (end-of-line)
2101             (if (not (= length (- (point) beg)))
2102                 (insert (make-string (- length (- (point) beg)) ? ))))
2103           (forward-line 1))))))
2104
2105 (defun gnus-uu-initialize ()
2106   (setq gnus-uu-highest-article-number 1)
2107   (gnus-uu-check-for-generated-files)
2108   (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir))
2109   (if (string-match "[^/]$" gnus-uu-tmp-dir)
2110       (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/")))
2111   (if (not (file-directory-p gnus-uu-tmp-dir))
2112       (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
2113     (if (not (file-writable-p gnus-uu-tmp-dir))
2114         (error "Temp directory %s can't be written to" gnus-uu-tmp-dir)))
2115   (setq gnus-uu-work-dir
2116         (concat gnus-uu-tmp-dir (make-temp-name "gnus")))
2117   (gnus-uu-add-file gnus-uu-work-dir)
2118   (if (not (file-directory-p gnus-uu-work-dir))
2119       (make-directory gnus-uu-work-dir))
2120   (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/"))
2121   (setq gnus-uu-interactive-file-list nil))
2122
2123 ; Kills the temporary uu buffers, kills any processes, etc.
2124 (defun gnus-uu-clean-up ()
2125   (let (buf pst)
2126     (and gnus-uu-uudecode-process
2127          (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
2128          (if (or (eq pst 'stop) (eq pst 'run))
2129              (delete-process gnus-uu-uudecode-process)))
2130     (and (not gnus-uu-asynchronous)
2131          (setq buf (get-buffer gnus-uu-output-buffer-name))
2132          (kill-buffer buf))))
2133
2134 ; `gnus-uu-check-for-generated-files' deletes any generated files that
2135 ; hasn't been deleted, if, for instance, the user terminated decoding
2136 ; with `C-g'.
2137 (defun gnus-uu-check-for-generated-files ()
2138   (let (file dirs)
2139     (while gnus-uu-generated-file-list
2140       (setq file (car gnus-uu-generated-file-list))
2141       (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list))
2142       (if (not (string-match "/\\.[\\.]?$" file))
2143           (progn
2144             (if (file-directory-p file)
2145                 (setq dirs (cons file dirs))
2146               (if (file-exists-p file)
2147                   (delete-file file))))))
2148     (setq dirs (nreverse dirs))
2149     (while dirs
2150       (setq file (car dirs))
2151       (setq dirs (cdr dirs))
2152       (if (file-directory-p file)
2153           (if (string-match "/$" file)
2154               (delete-directory (substring file 0 (match-beginning 0)))
2155             (delete-directory file))))))
2156
2157 ; Add a file (or a list of files) to be checked (and deleted if it/they
2158 ; still exists upon exiting the newsgroup).
2159 (defun gnus-uu-add-file (file)
2160   (if (stringp file)
2161       (setq gnus-uu-generated-file-list
2162             (cons file gnus-uu-generated-file-list))
2163     (setq gnus-uu-generated-file-list
2164           (append file gnus-uu-generated-file-list))))
2165
2166 ; Go to the next unread subject. If there is no further unread
2167 ; subjects, go to the last subject in the buffer.
2168 (defun gnus-uu-summary-next-subject ()
2169   (let (opi)
2170     (if (not (gnus-summary-search-forward t))
2171         (progn
2172           (goto-char 1)
2173           (sit-for 0)
2174           (gnus-summary-goto-subject gnus-uu-highest-article-number)))
2175
2176     ; You may well find all this a bit puzzling - so do I, but I seem
2177     ; to have to do something like this to move to the next unread article,
2178     ; as `sit-for' seems to do some rather strange things here. Might
2179     ; be a bug in my head, probably.
2180     (setq opi (point))
2181     (sit-for 0)
2182     (goto-char opi)
2183     (gnus-summary-recenter)))
2184
2185 ; Inputs an action and a file and returns a full command, putting
2186 ; ticks round the file name and escaping any ticks in the file name.
2187 (defun gnus-uu-command (action file)
2188   (let ((ofile ""))
2189     (while (string-match "`\\|\"\\|\\$\\|\\\\" file)
2190       (progn
2191         (setq ofile
2192               (concat ofile (substring file 0 (match-beginning 0)) "\\"
2193                       (substring file (match-beginning 0) (match-end 0))))
2194         (setq file (substring file (1+ (match-beginning 0))))))
2195     (setq ofile (concat "\"" ofile file "\""))
2196     (if (string-match "%s" action)
2197         (format action ofile)
2198       (concat action " " ofile))))
2199
2200
2201 ;; Initializing
2202 (add-hook 'gnus-exit-group-hook
2203       '(lambda ()
2204          (gnus-uu-clean-up)
2205          (gnus-uu-check-for-generated-files)))
2206
2207
2208 ;; Interactive exec mode
2209
2210 (defvar gnus-uu-output-window nil)
2211 (defvar gnus-uu-mode-hook nil)
2212
2213 (defvar gnus-uu-mode-map nil)
2214 (if gnus-uu-mode-map
2215     ()
2216   (setq gnus-uu-mode-map (make-sparse-keymap))
2217   (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
2218   (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
2219   (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
2220   (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
2221   (define-key gnus-uu-mode-map "\C-cs"
2222     'gnus-uu-interactive-save-current-file)
2223   (define-key gnus-uu-mode-map "\C-c\C-s"
2224     'gnus-uu-interactive-save-current-file-silent)
2225   (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files)
2226   (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)
2227   (define-key gnus-uu-mode-map "\C-c\C-r" 'gnus-uu-interactive-rescan-directory)
2228   (define-key gnus-uu-mode-map "\C-cr" 'gnus-uu-interactive-scan-directory)
2229   )
2230
2231 (defun gnus-uu-interactive-set-up-windows ()
2232   (let (int-buf out-buf height)
2233     (gnus-configure-windows 'article)
2234     (set-buffer
2235      (setq int-buf (get-buffer-create gnus-uu-interactive-buffer-name)))
2236     (if (not (get-buffer-window int-buf))
2237         (progn
2238           (select-window (get-buffer-window gnus-article-buffer))
2239           (switch-to-buffer int-buf)))
2240     (setq out-buf (get-buffer-create gnus-uu-output-buffer-name))
2241     (if (not (get-buffer-window out-buf))
2242         (progn
2243           (if (> 2 (setq height (- (window-height)
2244                                    gnus-uu-output-window-height)))
2245               (setq height (/ (window-height) 2)))
2246           (if (> height 2)
2247               (progn
2248                 (setq gnus-uu-output-window (split-window nil height))
2249                 (set-window-buffer gnus-uu-output-window out-buf)))))))
2250
2251 (defun gnus-uu-do-interactive (&optional dont-do-windows)
2252   (if (not gnus-uu-interactive-file-list)
2253       (gnus-uu-enter-interactive-file "#" ""))
2254   (if (not dont-do-windows) (gnus-uu-interactive-set-up-windows))
2255   (save-excursion
2256     (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
2257     (erase-buffer))
2258   (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name))
2259   (goto-char 1)
2260   (forward-line 3)
2261   (run-hooks 'gnus-uu-mode-hook))
2262
2263 (defun gnus-uu-enter-interactive-file (action file)
2264   (let (command)
2265     (save-excursion
2266       (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name))
2267       (if (not gnus-uu-interactive-file-list)
2268           (progn
2269             (erase-buffer)
2270             (gnus-uu-mode)
2271             (insert
2272              "# Press return to execute a command.
2273 # Press `C-c C-c' to exit interactive view.
2274
2275 ")))
2276       (setq gnus-uu-interactive-file-list
2277             (cons file gnus-uu-interactive-file-list))
2278 ;      (if (string-match (concat "^" gnus-uu-work-dir) file)
2279 ;         (setq file (substring file (match-end 0))))
2280       (setq command (gnus-uu-command action file))
2281       (goto-char (point-max))
2282       (insert (format "%s\n" command)))))
2283
2284 (defun gnus-uu-interactive-execute ()
2285   "Executes the command on the current line in interactive mode."
2286   (interactive)
2287   (let (beg out-buf command)
2288     (beginning-of-line)
2289     (setq beg (point))
2290     (end-of-line)
2291     (setq command (buffer-substring beg (point)))
2292     (setq out-buf (get-buffer-create gnus-uu-output-buffer-name))
2293     (save-excursion
2294       (set-buffer out-buf)
2295       (erase-buffer)
2296       (insert (format "$ %s \n\n" command)))
2297     (setq command (format "cd %s ; %s" gnus-uu-work-dir command))
2298     (message "Executing...")
2299     (if gnus-uu-asynchronous
2300         (start-process "gnus-uu-view" out-buf "sh" "-c" command)
2301       (call-process "sh" nil out-buf nil "-c" command)
2302       (message ""))
2303     (end-of-line)
2304     (if (= (forward-line 1) 1)
2305         (progn
2306           (end-of-line)
2307           (insert "\n")))
2308     (beginning-of-line)))
2309
2310 (defun gnus-uu-interactive-end ()
2311   "This function exits interactive view mode and returns to summary mode."
2312   (interactive)
2313   (let (buf)
2314     (if (windowp gnus-uu-output-window) (delete-window gnus-uu-output-window))
2315     (gnus-configure-windows 'article)
2316     (gnus-uu-clean-up)
2317     (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files))
2318     (setq buf (get-buffer gnus-uu-interactive-buffer-name))
2319     (if gnus-article-buffer (switch-to-buffer gnus-article-buffer))
2320     (if buf (kill-buffer buf))
2321     (pop-to-buffer gnus-summary-buffer)))
2322
2323
2324 (defun gnus-uu-interactive-scan-directory (dir)
2325   "Read any directory and view the files.
2326 When used in interactive mode, the files and commands will be displayed,
2327 as usual, in the interactive mode buffer."
2328   (interactive "DDirectory: ")
2329   (setq gnus-uu-interactive-file-list nil)
2330   (gnus-uu-view-directory dir gnus-uu-use-interactive-view)
2331   (gnus-uu-do-interactive t))
2332
2333 (defun gnus-uu-interactive-rescan-directory ()
2334   "Reread the directory and view the files.
2335 When used in interactive mode, the files and commands will be displayed,
2336 as usual, in the interactive mode buffer."
2337   (interactive)
2338   (gnus-uu-interactive-scan-directory gnus-uu-work-dir))
2339
2340 (defun gnus-uu-interactive-save-original-file ()
2341   "Saves the file from whence the file on the current line came from."
2342   (interactive)
2343   (let ((files gnus-uu-list-of-files-decoded)
2344         (filestr "")
2345         file did dir)
2346     (while files
2347       (setq file (car files))
2348       (setq files (cdr files))
2349       (if (file-exists-p file)
2350           (progn
2351             (if (not did)
2352                 (progn
2353                   (setq dir (gnus-uu-read-directory
2354                              (format "Where do you want the file%s? "
2355                                      (if (> (length files) 1) "s" ""))))
2356                   (setq did t)))
2357             (setq filestr (concat filestr (gnus-uu-name-from-path file) " "))
2358             (gnus-uu-save-file file dir t)))
2359       (if did
2360           (message "Saved %s" filestr)
2361         (message "Already saved.")))))
2362
2363 (defun gnus-uu-interactive-save-current-file-silent ()
2364   "Saves the file referred to on the current line in the current directory."
2365   (interactive)
2366   (gnus-uu-interactive-save-current-file t))
2367
2368 (defun gnus-uu-interactive-save-current-file (&optional dont-ask silent)
2369   "Saves the file referred to on the current line."
2370   (interactive)
2371   (let (files beg line file)
2372     (setq files (copy-sequence gnus-uu-interactive-file-list))
2373     (beginning-of-line)
2374     (setq beg (point))
2375     (end-of-line)
2376     (setq line (buffer-substring beg (point)))
2377     (while (and files
2378                 (not (string-match
2379                       (concat "" (regexp-quote (setq file (car files))) "")
2380                       line)))
2381       (setq files (cdr files)))
2382     (beginning-of-line)
2383     (forward-line 1)
2384     (if (not files)
2385         (if (not silent)
2386             (progn (message "Could not find file") (sit-for 2)))
2387       (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent)
2388       (delete-region beg (point)))))
2389
2390 (defun gnus-uu-interactive-save-all-files ()
2391   "Saves all files referred to in the interactive buffer."
2392   (interactive)
2393   (let (dir)
2394     (goto-char 1)
2395     (setq dir (gnus-uu-read-directory "Where do you want the files? "))
2396     (while (not (eobp))
2397       (gnus-uu-interactive-save-current-file t t))))
2398
2399 (defun gnus-uu-mode ()
2400   "Major mode for editing view commands in gnus-uu.
2401
2402 Commands:
2403 \\<gnus-uu-mode-map>Return, C-c C-v, C-c C-x        Execute the current command
2404 \\[gnus-uu-interactive-end]\tEnd interactive mode
2405 \\[gnus-uu-interactive-save-current-file]\tSave the current file
2406 \\[gnus-uu-interactive-save-current-file-silent]\tSave the current file without asking
2407 \twhere to put it
2408 \\[gnus-uu-interactive-save-all-files]\tSave all files
2409 \\[gnus-uu-interactive-save-original-file]\tSave the original file: If the files
2410 \toriginated in an archive, the archive
2411 \tfile is saved.
2412 \\[gnus-uu-interactive-rescan-directory]\tRescan the directory
2413 \\[gnus-uu-interactive-scan-directory]\tScan any directory
2414 "
2415   (interactive)
2416   (kill-all-local-variables)
2417   (use-local-map gnus-uu-mode-map)
2418   (setq mode-name "gnus-uu")
2419   (setq major-mode 'gnus-uu-mode)
2420 )
2421
2422   (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
2423   (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
2424   (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
2425   (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
2426   (define-key gnus-uu-mode-map "\C-cs"
2427     'gnus-uu-interactive-save-current-file)
2428   (define-key gnus-uu-mode-map "\C-c\C-s"
2429     'gnus-uu-interactive-save-current-file-silent)
2430   (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files)
2431   (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)
2432
2433
2434 ;; Major mode for posting encoded articles.
2435
2436 (require 'sendmail)
2437 (require 'rnews)
2438
2439 ; Any function that is to be used as and encoding method will take two
2440 ; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
2441 ; and "spiral.jpg", respectively.) The function should return nil if
2442 ; the encoding wasn't successful.
2443 (defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
2444   "Function used for encoding binary files.
2445 There are three functions supplied with gnus-uu for encoding files:
2446 `gnus-uu-post-encode-uuencode', which does straight uuencoding;
2447 `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
2448 headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
2449 uuencode and adds MIME headers.")
2450
2451 (defvar gnus-uu-post-include-before-composing nil
2452   "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
2453 If this variable is t, you can either include an encoded file with
2454 \\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
2455
2456 (defvar gnus-uu-post-length 990
2457   "Maximum length of an article.
2458 The encoded file will be split into how many articles it takes to
2459 post the entire file.")
2460
2461 (defvar gnus-uu-post-threaded nil
2462   "Non-nil means that gnus-uu will post the encoded file in a thread.
2463 This may not be smart, as no other decoder I have seen are able to
2464 follow threads when collecting uuencoded articles. (Well, I have seen
2465 one package that does that - gnus-uu, but somehow, I don't think that
2466 counts...) Default is nil.")
2467
2468 (defvar gnus-uu-post-separate-description t
2469   "Non-nil means that the description will be posted in a separate article.
2470 The first article will typically be numbered (0/x). If this variable
2471 is nil, the description the user enters will be included at the
2472 beginning of the first article, which will be numbered (1/x). Default
2473 is t.")
2474
2475 (defconst gnus-uu-post-binary-separator "--binary follows this line--")
2476 (defvar gnus-uu-post-message-id nil)
2477 (defvar gnus-uu-post-inserted-file-name nil)
2478 (defvar gnus-uu-winconf-post-news nil)
2479
2480 ; The following map and mode was taken from rnewspost.el and edited
2481 ; somewhat.
2482 (defvar gnus-uu-post-reply-mode-map () "Mode map used by gnus-uu-post-reply.")
2483 (or gnus-uu-post-reply-mode-map
2484     (progn
2485       (setq gnus-uu-post-reply-mode-map (make-keymap))
2486       (define-key gnus-uu-post-reply-mode-map "\C-c?" 'describe-mode)
2487       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-d"
2488         'news-reply-distribution)
2489       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-k"
2490         'news-reply-keywords)
2491       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-n"
2492         'news-reply-newsgroups)
2493
2494       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-f"
2495         'news-reply-followup-to)
2496       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
2497       (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-a"
2498         'gnus-uu-post-reply-summary)
2499       (define-key gnus-uu-post-reply-mode-map "\C-c\C-r"
2500         'news-caesar-buffer-body)
2501       (define-key gnus-uu-post-reply-mode-map "\C-c\C-w" 'news-reply-signature)
2502       (define-key gnus-uu-post-reply-mode-map "\C-c\C-y"
2503         'news-reply-yank-original)
2504       (define-key gnus-uu-post-reply-mode-map "\C-c\C-q"
2505         'mail-fill-yanked-message)
2506       (define-key gnus-uu-post-reply-mode-map "\C-c\C-c"
2507         'gnus-uu-post-news-inews)
2508       (define-key gnus-uu-post-reply-mode-map "\C-c\C-s"
2509         'gnus-uu-post-news-inews)
2510       (define-key gnus-uu-post-reply-mode-map "\C-c\C-i"
2511         'gnus-uu-post-insert-binary-in-article)
2512       ))
2513
2514 ; This mode was taken from rnewspost.el and modified slightly.
2515 (defun gnus-uu-post-reply-mode ()
2516   "Major mode for editing binary news to be posted on USENET.
2517 First-time posters are asked to please read the articles in newsgroup:
2518                                                      news.announce.newusers .
2519
2520 Like news-reply-mode, which is like Text Mode, but with these
2521 additional commands:
2522
2523 \\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-news-inews]  post the message.
2524 C-c C-f  move to a header field (and create it if there isn't):
2525          C-c C-f C-n  move to Newsgroups:       C-c C-f C-s  move to Subj:
2526          C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
2527          C-c C-f C-d  move to Distribution:     C-c C-f C-a  move to Summary:
2528 C-c C-y  news-reply-yank-original (insert current message, in NEWS).
2529 C-c C-q  mail-fill-yanked-message (fill what was yanked).
2530 C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13).
2531 \\[gnus-uu-post-insert-binary-in-article]  encode and include a file in this article.
2532
2533 This mode is almost identical to news-reply-mode, but has some
2534 additional commands for treating encoded binary articles. In
2535 particular, \\[gnus-uu-post-news-inews] will ask for a file to include, if
2536 one hasn't been included already. It will post, first, the message
2537 composed, and then it will post as many additional articles it takes
2538 to post the entire encoded files.
2539
2540    Relevant Variables
2541
2542    `gnus-uu-post-encode-method'
2543    There are three functions supplied with gnus-uu for encoding files:
2544    `gnus-uu-post-encode-uuencode', which does straight uuencoding;
2545    `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
2546    headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
2547    uuencode and adds MIME headers.
2548
2549    `gnus-uu-post-include-before-composing'
2550    Non-nil means that gnus-uu will ask for a file to encode before you
2551    compose the article.  If this variable is t, you can either include
2552    an encoded file with `C-c C-i' or have one included for you when you
2553    post the article.
2554
2555    `gnus-uu-post-length'
2556    Maximum length of an article. The encoded file will be split into how
2557    many articles it takes to post the entire file.
2558
2559    `gnus-uu-post-separate-description'
2560    Non-nil means that the description will be posted in a separate
2561    article. The first article will typically be numbered (0/x). If
2562    this variable is nil, the description the user enters will be
2563    included at the beginning of the first article, which will be
2564    numbered (1/x). Default is t.
2565
2566    `gnus-uu-post-threaded'
2567    Non-nil means that gnus-uu will post the encoded file in a thread.
2568    This may not be smart, as no other decoder I have seen are able to
2569    follow threads when collecting uuencoded articles. (Well, I have seen
2570    one package that does that - gnus-uu, but somehow, I don't think that
2571    counts...) Default is nil.
2572 "
2573   (interactive)
2574   ;; require...
2575   (or (fboundp 'mail-setup) (load "sendmail"))
2576   (kill-all-local-variables)
2577   (make-local-variable 'mail-reply-buffer)
2578   (setq mail-reply-buffer nil)
2579   (set-syntax-table text-mode-syntax-table)
2580   (use-local-map gnus-uu-post-reply-mode-map)
2581   (setq local-abbrev-table text-mode-abbrev-table)
2582   (setq major-mode 'gnus-uu-post-reply-mode)
2583   (setq mode-name "Gnus UU News")
2584   (make-local-variable 'paragraph-separate)
2585   (make-local-variable 'paragraph-start)
2586   (setq paragraph-start (concat "^" mail-header-separator "$\\|"
2587                                 paragraph-start))
2588   (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
2589                                    paragraph-separate))
2590   (run-hooks 'text-mode-hook 'gnus-uu-post-reply-mode-hook))
2591
2592 (defun gnus-uu-post-news ()
2593   "Compose an article and post an encoded file."
2594   (interactive)
2595   (setq gnus-uu-post-inserted-file-name nil)
2596   (setq gnus-uu-winconf-post-news (current-window-configuration))
2597   (let (news-reply-mode)
2598     (fset 'news-reply-mode 'gnus-uu-post-reply-mode)
2599     (gnus-summary-post-news)
2600     (if gnus-uu-post-include-before-composing
2601         (save-excursion (setq gnus-uu-post-inserted-file-name
2602                               (gnus-uu-post-insert-binary))))))
2603
2604 (defun gnus-uu-post-insert-binary-in-article ()
2605   "Inserts an encoded file in the buffer.
2606 The user will be asked for a file name."
2607   (interactive)
2608   (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer)))
2609       (error "Not in post-news buffer"))
2610   (save-excursion
2611     (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
2612
2613 ; Encodes with uuencode and substitutes all spaces with backticks.
2614 (defun gnus-uu-post-encode-uuencode (path file-name)
2615   (if (gnus-uu-post-encode-file "uuencode" path file-name)
2616       (progn
2617         (goto-char 1)
2618         (forward-line 1)
2619         (while (re-search-forward " " nil t)
2620           (replace-match "`"))
2621         t)))
2622
2623 ; Encodes with uuencode and adds MIME headers.
2624 (defun gnus-uu-post-encode-mime-uuencode (path file-name)
2625   (if (gnus-uu-post-encode-uuencode path file-name)
2626       (progn
2627         (gnus-uu-post-make-mime file-name "x-uue")
2628         t)))
2629
2630 ; Encodes with base64 and adds MIME headers
2631 (defun gnus-uu-post-encode-mime (path file-name)
2632   (if (gnus-uu-post-encode-file "mmencode" path file-name)
2633       (progn
2634         (gnus-uu-post-make-mime file-name "base64")
2635         t)))
2636
2637 ; Adds MIME headers.
2638 (defun gnus-uu-post-make-mime (file-name encoding)
2639   (goto-char 1)
2640   (insert (format "Content-Type: %s; name=\"%s\"\n"
2641                   (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
2642                   file-name))
2643   (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
2644   (save-restriction
2645     (set-buffer gnus-post-news-buffer)
2646     (goto-char 1)
2647     (re-search-forward mail-header-separator)
2648     (beginning-of-line)
2649     (forward-line -1)
2650     (narrow-to-region 1 (point))
2651     (or (mail-fetch-field "mime-version")
2652         (progn
2653           (widen)
2654           (insert "MIME-Version: 1.0\n")))
2655     (widen)))
2656
2657 ; Encodes a file PATH with COMMAND, leaving the result in the
2658 ; current buffer.
2659 (defun gnus-uu-post-encode-file (command path file-name)
2660   (= 0 (call-process "sh" nil t nil "-c"
2661                      (format "%s %s %s" command path file-name))))
2662
2663 (defun gnus-uu-post-news-inews ()
2664   "Posts the composed news article and encoded file.
2665 If no file has been included, the user will be asked for a file."
2666   (interactive)
2667   (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer)))
2668       (error "Not in post news buffer"))
2669
2670   (let (file-name)
2671
2672     (if gnus-uu-post-inserted-file-name
2673         (setq file-name gnus-uu-post-inserted-file-name)
2674       (setq file-name (gnus-uu-post-insert-binary)))
2675
2676     (if gnus-uu-post-threaded
2677         (let ((gnus-required-headers
2678                (if (memq 'Message-ID gnus-required-headers)
2679                    gnus-required-headers
2680                  (cons 'Message-ID gnus-required-headers)))
2681               gnus-inews-article-hook elem)
2682
2683           (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
2684                                             gnus-inews-article-hook
2685                                           (list gnus-inews-article-hook)))
2686           (setq gnus-inews-article-hook
2687                 (cons
2688                  '(lambda ()
2689                     (save-excursion
2690                       (goto-char 1)
2691                       (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
2692                           (setq gnus-uu-post-message-id
2693                                 (buffer-substring
2694                                  (match-beginning 1) (match-end 1)))
2695                         (setq gnus-uu-post-message-id nil))))
2696                  gnus-inews-article-hook))
2697           (gnus-uu-post-encoded file-name t))
2698       (gnus-uu-post-encoded file-name nil)))
2699   (setq gnus-uu-post-inserted-file-name nil)
2700   (and gnus-uu-winconf-post-news
2701        (set-window-configuration gnus-uu-winconf-post-news)))
2702
2703 ; Asks for a file to encode, encodes it and inserts the result in
2704 ; the current buffer. Returns the file name the user gave.
2705 (defun gnus-uu-post-insert-binary ()
2706   (let ((uuencode-buffer-name "*uuencode buffer*")
2707         file-path post-buf uubuf file-name)
2708
2709     (setq file-path (read-file-name
2710                      "What file do you want to encode? "))
2711     (if (not (file-exists-p file-path))
2712         (error "%s: No such file" file-path))
2713
2714     (goto-char (point-max))
2715     (insert (format "\n%s\n" gnus-uu-post-binary-separator))
2716
2717     (if (string-match "^~/" file-path)
2718         (setq file-path (concat "$HOME" (substring file-path 1))))
2719     (if (string-match "/[^/]*$" file-path)
2720         (setq file-name (substring file-path (1+ (match-beginning 0))))
2721       (setq file-name file-path))
2722
2723     (unwind-protect
2724         (if (save-excursion
2725               (set-buffer (setq uubuf
2726                                 (get-buffer-create uuencode-buffer-name)))
2727               (erase-buffer)
2728               (funcall gnus-uu-post-encode-method file-path file-name))
2729             (insert-buffer uubuf)
2730           (error "Encoding unsuccessful"))
2731       (kill-buffer uubuf))
2732     file-name))
2733
2734 ; Posts the article and all of the encoded file.
2735 (defun gnus-uu-post-encoded (file-name &optional threaded)
2736   (let ((send-buffer-name "*uuencode send buffer*")
2737         (encoded-buffer-name "*encoded buffer*")
2738         (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
2739         (separator (concat mail-header-separator "\n\n"))
2740         file uubuf length parts header i end beg
2741         beg-line minlen buf post-buf whole-len beg-binary end-binary)
2742
2743     (setq post-buf (current-buffer))
2744
2745     (goto-char 1)
2746     (if (not (re-search-forward
2747               (if gnus-uu-post-separate-description
2748                   gnus-uu-post-binary-separator
2749                 mail-header-separator) nil t))
2750         (error "Internal error: No binary/header separator"))
2751     (beginning-of-line)
2752     (forward-line 1)
2753     (setq beg-binary (point))
2754     (setq end-binary (point-max))
2755
2756     (save-excursion
2757       (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
2758       (erase-buffer)
2759       (insert-buffer-substring post-buf beg-binary end-binary)
2760       (goto-char 1)
2761       (setq length (count-lines 1 (point-max)))
2762       (setq parts (/ length gnus-uu-post-length))
2763       (if (not (< (% length gnus-uu-post-length) 4))
2764           (setq parts (1+ parts))))
2765
2766     (if gnus-uu-post-separate-description
2767         (forward-line -1))
2768     (kill-region (point) (point-max))
2769
2770     (goto-char 1)
2771     (search-forward mail-header-separator nil t)
2772     (beginning-of-line)
2773     (setq header (buffer-substring 1 (point)))
2774
2775     (goto-char 1)
2776     (if (not gnus-uu-post-separate-description)
2777         ()
2778       (if (and (not threaded) (re-search-forward "^Subject: " nil t))
2779           (progn
2780             (end-of-line)
2781             (insert (format " (0/%d)" parts))))
2782       (gnus-inews-news))
2783
2784     (save-excursion
2785       (setq i 1)
2786       (setq beg 1)
2787       (while (not (> i parts))
2788         (set-buffer (get-buffer-create send-buffer-name))
2789         (erase-buffer)
2790         (insert header)
2791         (if (and threaded gnus-uu-post-message-id)
2792             (insert (format "References: %s\n" gnus-uu-post-message-id)))
2793         (insert separator)
2794         (setq whole-len
2795               (- 62 (length (format top-string "" file-name i parts ""))))
2796         (if (> 1 (setq minlen (/ whole-len 2)))
2797             (setq minlen 1))
2798         (setq
2799          beg-line
2800          (format top-string
2801                  (make-string minlen ?-)
2802                  file-name i parts
2803                  (make-string
2804                   (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
2805
2806         (goto-char 1)
2807         (if (not (re-search-forward "^Subject: " nil t))
2808             ()
2809           (if (not threaded)
2810               (progn
2811                 (end-of-line)
2812                 (insert (format " (%d/%d)" i parts)))
2813             (if (or (and (= i 2) gnus-uu-post-separate-description)
2814                     (and (= i 1) (not gnus-uu-post-separate-description)))
2815                 (replace-match "Subject: Re: "))))
2816
2817         (goto-char (point-max))
2818         (save-excursion
2819           (set-buffer uubuf)
2820           (goto-char beg)
2821           (if (= i parts)
2822               (goto-char (point-max))
2823             (forward-line gnus-uu-post-length))
2824           (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
2825               (forward-line -4))
2826           (setq end (point)))
2827         (insert-buffer-substring uubuf beg end)
2828         (insert beg-line)
2829         (insert "\n")
2830         (setq beg end)
2831         (setq i (1+ i))
2832         (goto-char 1)
2833         (re-search-forward mail-header-separator nil t)
2834         (beginning-of-line)
2835         (forward-line 2)
2836         (if (re-search-forward gnus-uu-post-binary-separator nil t)
2837             (progn
2838               (replace-match "")
2839               (forward-line 1)))
2840         (insert beg-line)
2841         (insert "\n")
2842         (gnus-inews-news)))
2843
2844     (and (setq buf (get-buffer send-buffer-name))
2845          (kill-buffer buf))
2846     (and (setq buf (get-buffer encoded-buffer-name))
2847          (kill-buffer buf))
2848
2849     (if (not gnus-uu-post-separate-description)
2850         (progn
2851           (set-buffer-modified-p nil)
2852           (and (fboundp 'bury-buffer) (bury-buffer))))))
2853
2854 (provide 'gnus-uu)
2855
2856 ;; gnus-uu.el ends here