lisp/gnus-uu.el

   1 ;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Created: 2 Oct 1993
   7 ;; Keyword: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; All gnus-uu commands start with `C-c C-v'.
  28 ;;
  29 ;; Typing `C-c C-v C-v' (gnus-uu-decode-and-view) in the summary
  30 ;; buffer will try to find all articles in the same series, uudecode
  31 ;; them and view the resulting file(s).
  32 ;;
  33 ;; gnus-uu guesses what articles are in the series according to the
  34 ;; following simple rule: The subjects must be identical, except for
  35 ;; the last two numbers of the line.
  36 ;;
  37 ;; For example: If you choose a subject called "cat.gif (2/3)" gnus-uu
  38 ;; will find all the articles that matches "^cat.gif
  39 ;; ([0-9]+/[0-9]+).*$".  Subjects that are nonstandard, like "cat.gif
  40 ;; (2/3) Part 6 of a series", will not be properly recognized by 'C-c
  41 ;; C-v C-v', and you have to mark the articles manually with '#'.
  42 ;;
  43 ;; Typing `C-c C-v v' (gnus-uu-decode-and-save) will do the same as
  44 ;; `C-c C-v C-v', except that it will not display the resulting file, but
  45 ;; save it instead.
  46 ;;
  47 ;; Typing `C-c C-v s' (gnus-uu-shar-and-save) does the same as `C-c
  48 ;; C-v v', and `C-c C-v C-s' (gnus-uu-shar-and-view) does the same as
  49 ;; `C-c C-v C-v', except that they unshar files instead, i. e. run
  50 ;; them through /bin/sh. Most shar files can be viewed and/or saved
  51 ;; with the normal uudecode commands, which is much safer, as no
  52 ;; foreign code is run.
  53 ;;
  54 ;; `#' (gnus-uu-mark-article) marks an article for later
  55 ;; decoding/unsharing/saving/viewing. The files will be decoded in the
  56 ;; sequence they were marked. To decode the files after you've marked
  57 ;; the articles you are interested in, type the corresponding key
  58 ;; strokes as the normal decoding commands, but put a `M-' in the last
  59 ;; keystroke. For instance, to perform a standard uudecode and view,
  60 ;; you would type `C-c C-v C-v'. To perform a marked uudecode and
  61 ;; view, say `C-v C-v M-C-v'. All the other view and save commands are
  62 ;; handled the same way; marked uudecode and save is then `C-c C-v
  63 ;; M-v'.
  64 ;;
  65 ;; `M-#' (gnus-uu-unmark-article) will remove the mark from a
  66 ;; previosly marked article.
  67 ;;
  68 ;; `C-c C-v C-u' (gnus-uu-unmark-all-articles) will remove the mark from
  69 ;; all marked articles.
  70 ;;
  71 ;; `C-c C-v C-r' (gnus-uu-mark-by-regexp) will prompt for a regular
  72 ;; expression and mark (forward) all articles matching that regular
  73 ;; expression.
  74 ;;
  75 ;; There's an additional way to reach the decoding functions to make
  76 ;; future expansions easier: `C-c C-v C-m'
  77 ;; (gnus-uu-multi-decode-and-view) and the corresponding save, marked
  78 ;; view and marked save keystrokes, `C-c C-v m', `C-c C-v M-C-m' and
  79 ;; `C-c C-v M-m' respectively. You will be prompted for decoding
  80 ;; method, like uudecode, shar, binhex or plain save. Note that
  81 ;; methods like binhex and save doesn't have view modes; even if you
  82 ;; issue a view command (`C-c C-v C-m' and "binhex"), gnus-uu will
  83 ;; just save the resulting binhex file.
  84 ;;
  85 ;; `C-c C-v C-b' (gnus-uu-decode-and-show-in-buffer) will decode the
  86 ;; current article and display the results in an emacs buffer. This
  87 ;; might be useful if there's jsut some text in the current article
  88 ;; that has been uuencoded by some perverse poster.
  89 ;;
  90 ;; `C-c C-v a' (gnus-uu-decode-and-save-all-articles) looks at all the
  91 ;; articles in the current newsgroup and tries to uudecode everything
  92 ;; it can find. The user will be prompted for a directory where the
  93 ;; resulting files (if any) will be stored. `C-c C-v M-a' only looks
  94 ;; at unread article. `C-c C-v w' does the same as `C-c C-v a', but
  95 ;; also marks as read all articles it has peeked through, even if they
  96 ;; weren't uuencoded articles. `C-c C-v M-w' is, as you might have
  97 ;; guessed, similar to `C-c C-v M-a'.
  98 ;;
  99 ;; `C-c C-v C-l' (gnus-uu-edit-begin-line) lets you edit the begin
 100 ;; line of the current buffer. Useful to change an incorrect suffix or
 101 ;; an incorrect begin line.
 102 ;;
 103 ;;
 104 ;; When using the view commands, `C-c C-v C-v' for instance, gnus-uu
 105 ;; will (normally, see below) try to view the file according to the
 106 ;; rules given in gnus-uu-default-view-rules and
 107 ;; gnus-uu-user-view-rules. If it recognises the file, it will display
 108 ;; it immediately. If the file is some sort of archive, gnus-uu will
 109 ;; attempt to unpack the archive and see if any of the files in the
 110 ;; archive can be viewed. For instance, if you have a gzipped tar file
 111 ;; "pics.tar.gz" containing the files "pic1.jpg" and "pic2.gif",
 112 ;; gnus-uu will uncompress and detar the main file, and then view the
 113 ;; two pictures. This unpacking process is recursive, so if the
 114 ;; archive contains archives of archives, it'll all be unpacked.
 115 ;;
 116 ;; If the view command doesn't recognise the file type, or can't view
 117 ;; it because you don't have the viewer, or can't view *any* of the
 118 ;; files in the archive, the user will be asked if she wishes to have
 119 ;; the file saved somewhere. Note that if the decoded file is an
 120 ;; archive, and gnus-uu manages to view some of the files in the
 121 ;; archive, it won't tell the user that there were some files that
 122 ;; were unviewable. See "Interactive view" for a different approach.
 123 ;;
 124 ;;
 125 ;; Note that gnus-uu adds a function to `gnus-exit-group-hook' to
 126 ;; clear the list of marked articles and check for any generated files
 127 ;; that might have escaped deletion if the user typed `C-g'.
 128 ;;
 129 ;;
 130 ;; `C-c C-v C-a' (gnus-uu-toggle-asynchronous) toggles the
 131 ;; gnus-uu-asynchronous variable. See below for explanation.
 132 ;;
 133 ;; `C-c C-v C-q' (gnus-uu-toggle-query) toggles the
 134 ;; gnus-uu-ask-before-view variable. See below for explanation.
 135 ;;
 136 ;; `C-c C-v C-p' (gnus-uu-toggle-always-ask) toggles the
 137 ;; gnus-uu-view-and-save variable. See below for explanation.
 138 ;;
 139 ;; `C-c C-v C-k' (gnus-uu-toggle-kill-carriage-return) toggles the
 140 ;; gnus-uu-kill-carriage-return variable. See below for explanation.
 141 ;;
 142 ;; `C-c C-v C-i' (gnus-uu-toggle-interactive-view) toggles interactive
 143 ;; mode. If it is turned on, gnus-uu won't view files immediately but
 144 ;; give you a buffer with the default commands and files and lets you
 145 ;; edit the commands and execute them at leisure.
 146 ;;
 147 ;; `C-c C-v C-t' (gnus-uu-toggle-any-variable) is an interface to the
 148 ;; five toggle commands listed above.
 149 ;;
 150 ;; gnus-uu-toggle-correct-stripped-articles toggles whether to check
 151 ;; and correct uuencoded articles that may have had trailing spaces
 152 ;; stripped by mailers.
 153 ;;
 154 ;;
 155 ;; Customization
 156 ;;
 157 ;; To load this file when starting gnus, put sumething like the
 158 ;; following in your .emacs file:
 159 ;;
 160 ;;   (setq gnus-group-mode-hook
 161 ;;      '(lambda () (load "gnus-uu")))
 162 ;;
 163 ;; To make gnus-uu use, for instance, "xli" to view JPEGs and GIFs,
 164 ;; put this in your .emacs file:
 165 ;;
 166 ;;   (setq gnus-uu-user-view-rules
 167 ;;       (list
 168 ;;        '("jpg$\\|gif$" "xli")
 169 ;;        ))
 170 ;;
 171 ;; This variable is a list where each list item is a list containing
 172 ;; two strings. The first string is a regular expression. If the file
 173 ;; name is matched by this expression, the command given in the
 174 ;; second string is executed on this file. If the command contains
 175 ;; "%s", the file will be inserted there in the command string. Eg.
 176 ;; "giftoppm %s | xv -" will result in the file name being inserted at
 177 ;; the "%s".
 178 ;;
 179 ;; If you don't want to display certain file types, like if you
 180 ;; haven't got sound capabilities, you could put something like
 181 ;;
 182 ;;   (setq gnus-uu-user-view-rules
 183 ;;       (list
 184 ;;        '("au$\\|voc$\\|wav$" nil)
 185 ;;        ))
 186 ;;
 187 ;; in your .emacs file.
 188 ;;
 189 ;; There's a similar variable called 'gnus-uu-user-archive-rules'
 190 ;; which gives a list of unarcers to use when looking inside archives
 191 ;; for files to display.
 192 ;;
 193 ;; If you don't want gnus-uu to look inside archives for files to
 194 ;; display, say
 195 ;;
 196 ;;   (setq gnus-uu-do-not-unpack-archives t)
 197 ;;
 198 ;;
 199 ;; If you want gnus-uu to ask you if you want to save a file after
 200 ;; viewing, say
 201 ;;
 202 ;;   (setq gnus-uu-view-and-save t)
 203 ;;
 204 ;;
 205 ;; If you don't want to wait for the viewing command to finish before
 206 ;; returning to emacs, say
 207 ;;
 208 ;;   (setq gnus-uu-asynchronous t)
 209 ;;
 210 ;;
 211 ;; This can be useful if you're viewing long .mod files, for instance,
 212 ;; which often takes several minutes. Note, however, that since
 213 ;; gnus-uu doesn't ask, and if you are viewing an archive with lots of
 214 ;; viewable files, you'll get them all up more or less at once, which
 215 ;; can be confusing, to say the least. To get gnus-uu to ask you
 216 ;; before viewing a file, say
 217 ;;
 218 ;;   (setq gnus-uu-ask-before-view t)
 219 ;;
 220 ;; You can set this variable even if you're not using asynchronous
 221 ;; viewing, of course.
 222 ;;
 223 ;; If the articles has been posted by some numbscull with a PC (isn't
 224 ;; that a bit redundant, though?) and there's lots of carriage returns
 225 ;; everywhere, say
 226 ;;
 227 ;;   (setq gnus-uu-kill-carriage-return t)
 228 ;;
 229 ;; If you want gnus-uu to ignore the default file rules when viewing,
 230 ;; for instance if there's several file types that you can't view, set
 231 ;; `gnus-uu-ignore-default-view-rules' to `t'. There's a similar
 232 ;; variable to disable the default unarchive rule list,
 233 ;; `gnus-uu-ignore-default-archive-rules'.
 234 ;;
 235 ;; If you want a more interactive approach to file viewing, say
 236 ;;
 237 ;;   (setq gnus-uu-use-interactive-view t)
 238 ;;
 239 ;; If this variable is set, whenever you type `C-c C-v C-v' (or any of
 240 ;; the other view commands), gnus-uu will present you with a buffer
 241 ;; with the default actions and file names after decoding. You can
 242 ;; edit the command lines and execute them in a convenient fashion.
 243 ;; The output from the commands will be displayed in a small window at
 244 ;; the bottom of the emacs window. End interactive mode by typing `C-c
 245 ;; C-c' in the view window.
 246 ;;
 247 ;; If you want gnus-uu to unmark articles that you have asked to
 248 ;; decode, but can't be decoded (if, for instance, the articles aren't
 249 ;; uuencoded files or the posting is incomplete), say
 250 ;;
 251 ;;   (setq gnus-uu-unmark-articles-not-decoded t)
 252 ;;
 253 ;;
 254 ;; History
 255 ;;
 256 ;; v1.0: First version released Oct 2 1992.
 257 ;;
 258 ;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'.
 259 ;; Changed (setq gnus-exit-group-hook) to (add-hook).  Removed
 260 ;; checking for "Re:" for finding parts.
 261 ;;
 262 ;; v2.2: Fixed handling of currupted archives. Changed uudecoding to
 263 ;; an asynchronous process to avoid loading tons of data into emacs
 264 ;; buffers. No longer reads articles emacs already have aboard.  Fixed
 265 ;; a firmer support for shar files. Made regexp searches for files
 266 ;; more convenient. Added `C-c C-l' for editing uucode begin
 267 ;; lines. Added multi-system decoder entry point. Added interactive
 268 ;; view mode. Added function for decoding and saving all uuencoded
 269 ;; articles in the current newsgroup.
 270 ;;
 271 ;; v2.3: After suggestions I have changed all the gnus-uu key bindings
 272 ;; to avoid hogging all the user keys (C-c LETTER). Also added
 273 ;; (provide) and fixed some saving stuff. First posted version to
 274 ;; gnu.emacs.sources.
 275 ;;
 276 ;; v2.4: Fixed some more in the save-all category. Automatic fixing of
 277 ;; uucode "begin" lines: names on the form of "dir/file" are
 278 ;; translated into "dir-file". Added a function for fixing stripped
 279 ;; uucode articles. Added binhex save.
 280 ;;
 281 ;;
 282 ;; Keymap overview:
 283 ;;
 284 ;; All commands start with `C-c C-v'. The difference is in the third
 285 ;; keystroke.  All view commands are `C-LETTER'. All save commands are
 286 ;; just `LETTER'. All marked commands are the same as the unmarked
 287 ;; commands, except that they have `M-' before in the last keystroke.
 288 ;;
 289 ;; `C-c C-v C-v'      gnus-uu-decode-and-view
 290 ;; `C-c C-v v'        gnus-uu-decode-and-save
 291 ;; `C-c C-v C-s'      gnus-uu-shar-and-view
 292 ;; `C-c C-v s'        gnus-uu-shar-and-save
 293 ;; `C-c C-v C-m'      gnus-uu-multi-decode-and-view
 294 ;; `C-c C-v m'        gnus-uu-multi-decode-and-save
 295 ;;
 296 ;; `C-c C-v C-b'      gnus-uu-decode-and-show-in-buffer
 297 ;; `C-c C-v C-l'      gnus-uu-edit-begin-line
 298 ;; `C-c C-v M-a'      gnus-uu-decode-and-save-all-unread-articles
 299 ;; `C-c C-v a'        gnus-uu-decode-and-save-all-articles
 300 ;; `C-c C-v M-w'      gnus-uu-decode-and-save-all-unread-articles-and-mark
 301 ;; `C-c C-v w'        gnus-uu-decode-and-save-all-articles-and-mark
 302 ;;
 303 ;; `#'                gnus-uu-mark-article
 304 ;; `M-#'              gnus-uu-unmark-article
 305 ;; `C-c C-v C-u'      gnus-uu-unmark-all-articles
 306 ;; `C-c C-v C-r'      gnus-uu-mark-by-regexp
 307 ;; `C-c C-v M-C-v'    gnus-uu-marked-decode-and-view
 308 ;; `C-c C-v M-v'      gnus-uu-marked-decode-and-save
 309 ;; `C-c C-v M-C-s'    gnus-uu-marked-shar-and-view
 310 ;; `C-c C-v M-s'      gnus-uu-marked-shar-and-save
 311 ;; `C-c C-v M-C-m'    gnus-uu-marked-multi-decode-and-view
 312 ;; `C-c C-v M-m'      gnus-uu-marked-multi-decode-and-save
 313 ;;
 314 ;; `C-c C-v C-a'      gnus-uu-toggle-asynchronous
 315 ;; `C-c C-v C-q'      gnus-uu-toggle-query
 316 ;; `C-c C-v C-p'      gnus-uu-toggle-always-ask
 317 ;; `C-c C-v C-k'      gnus-uu-toggle-kill-carriage-return
 318 ;; `C-c C-v C-i'      gnus-uu-toggle-interactive-view
 319 ;; `C-c C-v C-t'      gnus-uu-toggle-any-variable
 320
 321 ;;; Code:
 322
 323 (require 'gnus)
 324
 325 ;; Binding of keys to the gnus-uu functions.
 326
 327 (defvar gnus-uu-ctl-map nil)
 328 (define-prefix-command 'gnus-uu-ctl-map)
 329 (define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map)
 330
 331 (define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view)
 332 (define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save)
 333 (define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view)
 334 (define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save)
 335 (define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view)
 336 (define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save)
 337
 338 (define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer)
 339
 340 (define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article)
 341 (define-key gnus-summary-mode-map "\M-#" 'gnus-uu-unmark-article)
 342 (define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-unmark-all-articles)
 343 (define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp)
 344
 345 (define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view)
 346 (define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save)
 347 (define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view)
 348 (define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save)
 349 (define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view)
 350 (define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save)
 351
 352 (define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-toggle-asynchronous)
 353 (define-key gnus-uu-ctl-map "\C-q" 'gnus-uu-toggle-query)
 354 (define-key gnus-uu-ctl-map "\C-p" 'gnus-uu-toggle-always-ask)
 355 (define-key gnus-uu-ctl-map "\C-k" 'gnus-uu-toggle-kill-carriage-return)
 356 (define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view)
 357 (define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable)
 358
 359 (define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line)
 360
 361 (define-key gnus-uu-ctl-map "\M-a" 'gnus-uu-decode-and-save-all-unread-articles)
 362 (define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-articles)
 363 (define-key gnus-uu-ctl-map "\M-w" 'gnus-uu-decode-and-save-all-unread-articles-and-mark)
 364 (define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles-and-mark)
 365
 366 ;(load "rnewspost")
 367 ;(define-key news-reply-mode-map "\C-c\C-v" 'gnus-uu-uuencode-and-post)
 368
 369 ;; Default viewing action rules
 370
 371 (defconst gnus-uu-default-view-rules
 372   (list
 373    '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
 374    '("\\.tga$" "tgatoppm %s | xv -")
 375    '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less")
 376    '("\\.fli$" "xflick")
 377    '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
 378      "sox -v .5 %s -t .au -u - > /dev/audio")
 379    '("\\.au$" "cat %s > /dev/audio")
 380    '("\\.mod$" "str32")
 381    '("\\.ps$" "ghostview")
 382    '("\\.dvi$" "xdvi")
 383    '("\\.1$" "xterm -e man -l")
 384    '("\\.html$" "xmosaic")
 385    '("\\.mpe?g$" "mpeg_play")
 386    '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\)$"
 387      "gnus-uu-archive"))
 388
 389
 390   "This constant is a list that gives the default actions to be taken
 391 when the user asks to view a file. To change the behaviour, you can
 392 either edit this constant or set 'gnus-uu-user-view-rules' to
 393 something useful. To add a default \"end\" rule, edit the
 394 'gnus-uu-user-view-rules-end' variable.
 395
 396 For example:
 397
 398 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
 399 following in your .emacs file
 400
 401   (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\")))
 402
 403 Both these variables are lists of lists of strings, where the first
 404 string is a regular expression. If the file name matches this regular
 405 expression, the command in the second string is fed the file.
 406
 407 If the command string contains \"%s\", the file name will be inserted
 408 at that point in the command string. If there's no \"%s\" in the
 409 command string, the file name will be appended to the command before
 410 executing.  ")
 411
 412 (defvar gnus-uu-user-view-rules nil
 413   "User variable. See explanation of the 'gnus-uu-default-view-rules' for
 414 details.")
 415
 416 (defvar gnus-uu-user-view-rules-end nil
 417   "The user may use this variable to provide default viewing rules.")
 418
 419 (defvar gnus-uu-user-interactive-view-rules nil
 420   "If this variable is set and interactive mode is to be used, this
 421 variable will be used instead of gnus-uu-user-view-rules.")
 422
 423 (defvar gnus-uu-user-interactive-view-rules-end nil
 424   "If this variable is set and interactive mode is to be used, this
 425 variable will be used instead of gnus-uu-user-view-rules-end.")
 426
 427 (defconst gnus-uu-default-interactive-view-rules-begin
 428   (list
 429    '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/
//g")
 430    '("\\.pas$" "cat %s | sed s/
//g")
 431    ))
 432
 433
 434 ;; Default unpacking commands
 435
 436 (defconst gnus-uu-default-archive-rules
 437   (list '("\\.tar$" "tar xf")
 438         '("\\.zip$" "unzip")
 439         '("\\.ar$" "ar x")
 440         '("\\.arj$" "unarj x")
 441         '("\\.zoo$" "zoo -e")
 442         '("\\.lzh$" "lha x")
 443         '("\\.Z$" "uncompress")
 444         '("\\.gz$" "gunzip")
 445         '("\\.arc$" "arc -x"))
 446   "*")
 447 (defvar gnus-uu-user-archive-rules nil)
 448
 449
 450 ;; Various variables users may set
 451
 452 (defvar gnus-uu-tmp-dir "/tmp/"
 453   "Variable saying where gnus-uu is to do its work. Default is \"/tmp/\".")
 454
 455 (defvar gnus-uu-do-not-unpack-archives nil
 456   "Set this variable if you don't want gnus-uu to look inside
 457 archives for files to display. Default is `nil'.")
 458
 459 (defvar gnus-uu-do-not-unpack-archives nil
 460   "Set this variable if you don't want gnus-uu to look inside
 461 archives for files to display. Default is `nil'.")
 462
 463 (defvar gnus-uu-view-and-save nil
 464   "Set this variable if you want to be asked if you want to save the
 465 file after viewing. If this variable is nil, which is the default,
 466 gnus-uu won't offer to save a file if viewing is successful. Default
 467 is `nil'.")
 468
 469 (defvar gnus-uu-asynchronous nil
 470   "Set this variable to `t' if you don't want gnus-uu to wait until
 471 the viewing command has ended before returning control to emacs.
 472 Default is `nil'.")
 473
 474 (defvar gnus-uu-ask-before-view nil
 475   "Set this variable to `t' if you want gnus-uu to ask you before
 476 viewing every file. Useful when `gnus-uu-asynchronous' is set. Default
 477 is `nil'.")
 478
 479 (defvar gnus-uu-ignore-default-view-rules nil
 480   "Set this variable if you want gnus-uu to ignore the default viewing
 481 rules and just use the rules given in gnus-uu-user-view-rules. Default
 482 is `nil'.")
 483
 484 (defvar gnus-uu-ignore-default-archive-rules nil
 485   "Set this variable if you want gnus-uu to ignore the default archive
 486 unpacking commands and just use the rules given in
 487 gnus-uu-user-archive-rules. Default is `nil'.")
 488
 489 (defvar gnus-uu-kill-carriage-return t
 490   "Set this variable if you want to remove all carriage returns from
 491 the mail articles. Default is `t'.")
 492
 493 (defvar gnus-uu-unmark-articles-not-decoded nil
 494   "If this variable is set, artciles that are unsuccessfully decoded
 495 are marked as unread. Default is `nil'.")
 496
 497 (defvar gnus-uu-output-window-height 20
 498   "This variable says how hight the output buffer window is to be when
 499 using interactive view mode. Change it at your convenience. Default is 20.")
 500
 501 (defvar gnus-uu-correct-stripped-uucode nil
 502   "If this variable is set, gnus-uu will try to correct uuencoded files that
 503 have had trailing spaces stripped by nosy mail saoftware. Default is `nil'.")
 504
 505 (defvar gnus-uu-use-interactive-view nil
 506   "If this variable is set, gnus-uu will create a special buffer where
 507 the user may choose interactively which files to view and how. Default
 508 is `nil'.")
 509
 510
 511 ;; Internal variables
 512
 513 (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$"
 514   "*")
 515 (defconst gnus-uu-end-string "^end[ \t]*$")
 516 (defconst gnus-uu-body-line
 517 "^M.............................................................?$" "*")
 518 (defconst gnus-uu-shar-begin-string "^#! */bin/sh" "*")
 519
 520 (defvar gnus-uu-shar-file-name nil "*")
 521 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)" "*")
 522 (defvar gnus-uu-shar-directory nil)
 523
 524 (defvar gnus-uu-file-name nil)
 525 (defconst gnus-uu-uudecode-process nil)
 526
 527 (defvar gnus-uu-interactive-file-list nil)
 528 (defvar gnus-uu-marked-article-list nil)
 529 (defvar gnus-uu-generated-file-list nil)
 530
 531 (defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*")
 532 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
 533 (defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*")
 534
 535
 536 ;; Interactive functions
 537
 538 ;; UUdecode and view
 539
 540 (defun gnus-uu-decode-and-view ()
 541   "UUdecodes and 'views' (if possible) the resulting file.
 542 'Viewing' can be any action at all, as defined in the
 543 'gnus-uu-file-action-list' variable. Running 'xv' on gifs and
 544 'play' on au files are popular actions. If the file can't be viewed,
 545 the user is asked if she would like to save the file instead."
 546   (interactive)
 547   (gnus-uu-decode-and-view-or-save t nil))
 548
 549 (defun gnus-uu-decode-and-save ()
 550   "uudecodes and saves the resulting file."
 551   (interactive)
 552   (gnus-uu-decode-and-view-or-save nil nil))
 553
 554 (defun gnus-uu-marked-decode-and-view ()
 555   "The marked equivalent to gnus-uu-decode-and-view."
 556   (interactive)
 557   (gnus-uu-decode-and-view-or-save t t))
 558
 559 (defun gnus-uu-marked-decode-and-save ()
 560   "The marked equivalent to gnus-uu-decode-and-save."
 561   (interactive)
 562   (gnus-uu-decode-and-view-or-save nil t))
 563
 564
 565 ;; Unshar and view
 566
 567 (defun gnus-uu-shar-and-view ()
 568   "Does the same as gnus-uu-decode-and-view for shar files."
 569   (interactive)
 570   (gnus-uu-unshar-and-view-or-save t nil))
 571
 572 (defun gnus-uu-shar-and-save ()
 573   "Does the same as gnus-uu-decode-and-save for shar files."
 574   (interactive)
 575   (gnus-uu-unshar-and-view-or-save nil nil))
 576
 577 (defun gnus-uu-marked-shar-and-view ()
 578   "The marked equivalent to gnus-uu-shar-and-view."
 579   (interactive)
 580   (gnus-uu-unshar-and-view-or-save t t))
 581
 582 (defun gnus-uu-marked-shar-and-save ()
 583   "The marked equivalent to gnus-uu-shar-and-save."
 584   (interactive)
 585   (gnus-uu-unshar-and-view-or-save nil t))
 586
 587
 588 ;; Decode and show in buffer
 589
 590 (defun gnus-uu-decode-and-show-in-buffer ()
 591   "uudecodes the current article and displays the result in a buffer."
 592   (interactive)
 593   (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name))
 594         list-of-articles file-name)
 595     (save-excursion
 596       (and
 597        (setq list-of-articles (list gnus-current-article))
 598        (gnus-uu-grab-articles list-of-articles 'gnus-uu-uustrip-article-as)
 599        (setq file-name (gnus-uu-decode gnus-uu-tmp-dir))
 600        (progn
 601          (save-excursion
 602            (set-buffer uu-buffer)
 603            (erase-buffer)
 604            (insert-file-contents file-name))
 605          (set-window-buffer (get-buffer-window gnus-article-buffer)
 606                             uu-buffer)
 607          (message (format "Showing file %s in buffer" file-name))
 608          (delete-file file-name))))))
 609
 610
 611 ;; Toggle commands
 612
 613 (defun gnus-uu-toggle-asynchronous ()
 614   "This function toggles asynchronous viewing."
 615   (interactive)
 616   (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous))
 617       (message "gnus-uu will now view files asynchronously")
 618     (message "gnus-uu will now view files synchronously")))
 619
 620 (defun gnus-uu-toggle-query ()
 621   "This function toggles whether to ask before viewing or not."
 622   (interactive)
 623   (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view))
 624       (message "gnus-uu will now ask before viewing")
 625     (message "gnus-uu will now view without asking first")))
 626
 627 (defun gnus-uu-toggle-always-ask ()
 628   "This function toggles whether to ask saving a file even after successful
 629 viewing."
 630   (interactive)
 631   (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save))
 632       (message "gnus-uu will now ask to save the file after viewing")
 633     (message "gnus-uu will now not ask to save after successful viewing")))
 634
 635 (defun gnus-uu-toggle-interactive-view ()
 636   "This function toggles whether to use interactive view."
 637   (interactive)
 638   (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view))
 639       (message "gnus-uu will now use interactive view")
 640     (message "gnus-uu will now use non-interactive view")))
 641
 642 (defun gnus-uu-toggle-unmark-undecoded ()
 643   "This function toggles whether to unmark articles not decoded."
 644   (interactive)
 645   (if (setq gnus-uu-unmark-articles-not-decoded
 646             (not gnus-uu-unmark-articles-not-decoded))
 647       (message "gnus-uu will now unmark articles not decoded")
 648     (message "gnus-uu will now not unmark articles not decoded")))
 649
 650 (defun gnus-uu-toggle-kill-carriage-return ()
 651   "This function toggles the stripping of carriage returns from the articles."
 652   (interactive)
 653   (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return))
 654       (message "gnus-uu will now strip carriage returns")
 655     (message "gnus-uu won't strip carriage returns")))
 656
 657 (defun gnus-uu-toggle-correct-stripped-uucode ()
 658   "This function toggles whether to correct stripped uucode."
 659   (interactive)
 660   (if (setq gnus-uu-correct-stripped-uucode
 661             (not gnus-uu-correct-stripped-uucode))
 662       (message "gnus-uu will now correct stripped uucode")
 663     (message "gnus-uu won't check and correct stripped uucode")))
 664
 665 (defun gnus-uu-toggle-any-variable ()
 666   "This function ask what variable the user wants to toggle."
 667   (interactive)
 668   (let (rep)
 669     (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteractive, (u)nmark, (c)orrect")
 670     (setq rep (read-char))
 671     (if (= rep ?a)
 672         (gnus-uu-toggle-asynchronous))
 673     (if (= rep ?q)
 674         (gnus-uu-toggle-query))
 675     (if (= rep ?p)
 676         (gnus-uu-toggle-always-ask))
 677     (if (= rep ?k)
 678         (gnus-uu-toggle-kill-carriage-return))
 679     (if (= rep ?u)
 680         (gnus-uu-toggle-unmark-undecoded))
 681     (if (= rep ?c)
 682         (gnus-uu-toggle-correct-stripped-uucode))
 683     (if (= rep ?i)
 684         (gnus-uu-toggle-interactive-view))))
 685
 686
 687 ;; Edit line
 688
 689 (defun gnus-uu-edit-begin-line ()
 690   "Edit the begin line of the current article."
 691   (interactive)
 692   (let ((buffer-read-only nil)
 693         begin b)
 694     (save-excursion
 695       (set-buffer gnus-article-buffer)
 696       (goto-line 1)
 697       (if (not (re-search-forward "begin " nil t))
 698           (progn (message "No begin line in the current article") (sit-for 2))
 699         (beginning-of-line)
 700         (setq b (point))
 701         (end-of-line)
 702         (setq begin (buffer-substring b (point)))
 703         (setq begin (read-string "" begin))
 704         (setq buffer-read-only nil)
 705         (delete-region b (point))
 706         (insert-string begin)))))
 707
 708 ;; Multi functions
 709
 710 (defun gnus-uu-multi-decode-and-view ()
 711   "This function lets the user decide what method to use for decoding.
 712 Other than that, it's equivalent to the other decode-and-view functions."
 713   (interactive)
 714   (gnus-uu-multi-decode-and-view-or-save t nil))
 715
 716 (defun gnus-uu-multi-decode-and-save ()
 717   "This function lets the user decide what method to use for decoding.
 718 Other than that, it's equivalent to the other decode-and-save functions."
 719   (interactive)
 720   (gnus-uu-multi-decode-and-view-or-save nil nil))
 721
 722 (defun gnus-uu-marked-multi-decode-and-view ()
 723   "This function lets the user decide what method to use for decoding.
 724 Other than that, it's equivalent to the other marked decode-and-view
 725 functions."
 726   (interactive)
 727   (gnus-uu-multi-decode-and-view-or-save t t))
 728
 729 (defun gnus-uu-marked-multi-decode-and-save ()
 730   "This function lets the user decide what method to use for decoding.
 731 Other than that, it's equivalent to the other marked decode-and-save
 732 functions."
 733   (interactive)
 734   (gnus-uu-multi-decode-and-view-or-save t t))
 735
 736 (defun gnus-uu-multi-decode-and-view-or-save (view marked)
 737   (let (decode-type)
 738     (message "(u)udecode, (s)har, s(a)ve, (b)inhex: ")
 739     (setq decode-type (read-char))
 740     (if (= decode-type ?
) (setq decode-type ?u))
 741     (if (= decode-type ?u)
 742         (gnus-uu-decode-and-view-or-save view marked)
 743       (if (= decode-type ?s)
 744           (gnus-uu-unshar-and-view-or-save view marked)
 745         (if (= decode-type ?b)
 746             (gnus-uu-binhex-and-save view marked)
 747           (if (= decode-type ?a)
 748               (gnus-uu-save-articles view marked)
 749             (message (format "Unknown decode method '%c'." decode-type))
 750             (sit-for 2)))))))
 751
 752
 753 ;; uuencode and post
 754
 755 (defun gnus-uu-news-inews ()
 756   "Send a news message using inews."
 757   (interactive)
 758   (let* (newsgroups subject
 759                     (case-fold-search nil))
 760     (save-excursion
 761       (save-restriction
 762         (goto-char (point-min))
 763         (search-forward (concat "\n" mail-header-separator "\n"))
 764         (narrow-to-region (point-min) (point))
 765         (setq newsgroups (mail-fetch-field "newsgroups")
 766               subject (mail-fetch-field "subject")))
 767       (widen)
 768       (goto-char (point-min))
 769 ;      (run-hooks 'news-inews-hook)
 770       (goto-char (point-min))
 771       (search-forward (concat "\n" mail-header-separator "\n"))
 772       (replace-match "\n\n")
 773       (goto-char (point-max))
 774       ;; require a newline at the end for inews to append .signature to
 775       (or (= (preceding-char) ?\n)
 776           (insert ?\n))
 777       (message "Posting to USENET...")
 778       (call-process-region (point-min) (point-max)
 779                            news-inews-program nil 0 nil
 780                            "-h")        ; take all header lines!
 781                            ;@@ setting of subject and newsgroups still needed?
 782                            ;"-t" subject
 783                            ;"-n" newsgroups
 784       (message "Posting to USENET... done")
 785       (goto-char (point-min))           ;restore internal header separator
 786       (search-forward "\n\n")
 787       (replace-match (concat "\n" mail-header-separator "\n")))))
 788
 789 (autoload 'news-inews "rnewspost")
 790
 791 (defun gnus-uu-post-buffer (&optional first)
 792   (append-to-file 1 (point-max) "/tmp/gnusuutull")
 793 ;  (if first
 794 ;      (news-inews)
 795 ;    (gnus-uu-news-inews))
 796   (message "posted"))
 797
 798 (defconst gnus-uu-uuencode-post-length 20)
 799
 800 (defun gnus-uu-uuencode-and-post ()
 801   (interactive)
 802   (let (file uubuf sendbuf short-file length parts header i end beg
 803              beg-line minlen)
 804     (setq file (read-file-name
 805                 "What file do you want to uuencode and post? " "~/Unrd.jpg"))
 806     (if (not (file-exists-p file))
 807         (message "%s: No such file" file)
 808       (save-excursion
 809         (setq uubuf (get-buffer-create "*uuencode buffer*"))
 810         (setq sendbuf (get-buffer-create "*uuencode send buffer*"))
 811         (set-buffer uubuf)
 812         (erase-buffer)
 813         (if (string-match "^~/" file)
 814             (setq file (concat "$HOME" (substring file 1))))
 815         (if (string-match "/[^/]*$" file)
 816             (setq short-file (substring file (1+ (match-beginning 0))))
 817           (setq short-file file))
 818         (call-process "sh" nil uubuf nil "-c"
 819                       (format "uuencode %s %s" file short-file))
 820         (goto-char 1)
 821         (forward-line 1)
 822         (while (re-search-forward " " nil t)
 823           (replace-match "`"))
 824         (setq length (count-lines 1 (point-max)))
 825         (setq parts (/ length gnus-uu-uuencode-post-length))
 826         (if (not (< (% length gnus-uu-uuencode-post-length) 4))
 827             (setq parts (1+ parts)))
 828         (message "Det er %d parts" parts))
 829       (goto-char 1)
 830       (search-forward mail-header-separator nil t)
 831       (beginning-of-line)
 832       (forward-line 1)
 833       (setq header (buffer-substring 1 (point)))
 834       (goto-char 1)
 835       (if (re-search-forward "^Subject: " nil t)
 836           (progn
 837             (end-of-line)
 838             (insert (format " (0/%d)" parts))))
 839       (gnus-uu-post-buffer t)
 840       (save-excursion
 841         (set-buffer sendbuf)
 842         (setq i 1)
 843         (setq beg 1)
 844         (while (not (> i parts))
 845           (set-buffer sendbuf)
 846           (erase-buffer)
 847           (insert header)
 848           (insert "\n")
 849           (setq minlen (/ (- 62 (length (format " (%d/%d) " i parts))) 2))
 850           (setq beg-line (format "[ cut here %s (%d/%d) %s gnus-uu ]\n"
 851                           (make-string (- minlen 11) ?-) i parts
 852                           (make-string (- minlen 10) ?-)))
 853           (insert beg-line)
 854           (goto-char 1)
 855           (if (re-search-forward "^Subject: " nil t)
 856               (progn
 857                 (end-of-line)
 858                 (insert (format " (%d/%d)" i parts))))
 859           (goto-char (point-max))
 860           (save-excursion
 861             (set-buffer uubuf)
 862             (goto-char beg)
 863             (if (= i parts)
 864                 (goto-char (point-max))
 865               (forward-line gnus-uu-uuencode-post-length))
 866             (setq end (point)))
 867           (insert-buffer-substring uubuf beg end)
 868           (insert beg-line)
 869           (setq beg end)
 870           (setq i (1+ i))
 871           (gnus-uu-post-buffer)))
 872       )))
 873
 874
 875
 876 ;; Decode and all files
 877
 878 (defconst gnus-uu-rest-of-articles nil)
 879 (defconst gnus-uu-do-sloppy-uudecode nil)
 880 (defvar gnus-uu-current-save-dir nil "*")
 881
 882 (defun gnus-uu-decode-and-save-all-unread-articles ()
 883   "This function reads all unread articles in the current group and
 884 sees whether it can uudecode the articles. The user will be prompted
 885 for an directory to put the resulting (if any) files."
 886   (interactive)
 887   (gnus-uu-decode-and-save-articles t t))
 888
 889 (defun gnus-uu-decode-and-save-all-articles ()
 890   "Does the same as gnus-uu-decode-and-save-all-unread-articles, except
 891 that it grabs all articles visible, unread or not."
 892   (interactive)
 893   (gnus-uu-decode-and-save-articles nil t))
 894
 895 (defun gnus-uu-decode-and-save-all-unread-articles-and-mark ()
 896   "Does the same as gnus-uu-decode-and-save-all-unread-articles, except that
 897 it marks everything as read, even if it couldn't decode the articles."
 898   (interactive)
 899   (gnus-uu-decode-and-save-articles t nil))
 900
 901 (defun gnus-uu-decode-and-save-all-articles-and-mark ()
 902   "Does the same as gnus-uu-decode-and-save-all-articles, except that
 903 it marks everything as read, even if it couldn't decode the articles."
 904   (interactive)
 905   (gnus-uu-decode-and-save-articles nil nil))
 906
 907 (defun gnus-uu-decode-and-save-articles (&optional unread unmark)
 908   (let ((gnus-uu-unmark-articles-not-decoded unmark)
 909         (filest "")
 910         where dir did unmark saved-list)
 911     (setq gnus-uu-do-sloppy-uudecode t)
 912     (setq dir (gnus-uu-read-directory "Where do you want the files? "))
 913     (message "Grabbing...")
 914     (setq gnus-uu-rest-of-articles
 915           (gnus-uu-get-list-of-articles "^." nil unread))
 916     (setq gnus-uu-file-name nil)
 917     (while (and gnus-uu-rest-of-articles
 918                 (gnus-uu-grab-articles gnus-uu-rest-of-articles
 919                                        'gnus-uu-uustrip-article-as))
 920       (if gnus-uu-file-name
 921           (progn
 922             (setq saved-list (cons gnus-uu-file-name saved-list))
 923             (rename-file (concat gnus-uu-tmp-dir gnus-uu-file-name)
 924                          (concat dir gnus-uu-file-name) t)
 925             (setq did t)
 926             (setq gnus-uu-file-name nil))))
 927     (if (not did)
 928         ()
 929       (while saved-list
 930         (setq filest (concat filest " " (car saved-list)))
 931         (setq saved-list (cdr saved-list)))
 932       (message "Saved%s" filest)))
 933   (setq gnus-uu-do-sloppy-uudecode nil))
 934
 935
 936 ;; Work functions
 937
 938 (defun gnus-uu-decode-and-view-or-save (view marked)
 939   (gnus-uu-initialize)
 940   (let (file decoded)
 941     (save-excursion
 942       (if (gnus-uu-decode-and-strip nil marked)
 943           (progn
 944             (setq decoded t)
 945             (setq file (concat gnus-uu-tmp-dir gnus-uu-file-name))
 946             (if view
 947                 (gnus-uu-view-file file)
 948               (gnus-uu-save-file file)))))
 949
 950     (gnus-uu-summary-next-subject)
 951
 952     (if (and gnus-uu-use-interactive-view view decoded)
 953         (gnus-uu-do-interactive))
 954
 955     (if (or (not gnus-uu-use-interactive-view) (not decoded))
 956         (gnus-uu-clean-up))))
 957
 958
 959 (defun gnus-uu-unshar-and-view-or-save (view marked)
 960   "Unshars and views/saves marked/unmarked articles."
 961   (gnus-uu-initialize)
 962   (let (tar-file files decoded)
 963     (save-excursion
 964       (setq gnus-uu-shar-directory
 965             (make-temp-name (concat gnus-uu-tmp-dir "gnusuush")))
 966       (make-directory gnus-uu-shar-directory)
 967       (gnus-uu-add-file gnus-uu-shar-directory)
 968       (if (gnus-uu-decode-and-strip t marked)
 969           (progn
 970             (setq decoded t)
 971             (setq files (directory-files gnus-uu-shar-directory t))
 972             (setq gnus-uu-generated-file-list
 973                   (append files gnus-uu-generated-file-list))
 974             (if (> (length files) 3)
 975                 (progn
 976                   (setq tar-file
 977                         (concat
 978                          (make-temp-name (concat gnus-uu-tmp-dir "gnusuuar"))
 979                          ".tar"))
 980                   (gnus-uu-add-file tar-file)
 981                   (call-process "sh" nil
 982                                 (get-buffer-create gnus-uu-output-buffer-name)
 983                                 nil "-c"
 984                                 (format "cd %s ; tar cf %s * ; cd .. ; rm -r %s"
 985                                         gnus-uu-shar-directory
 986                                         tar-file
 987                                         gnus-uu-shar-directory))
 988                   (if view
 989                       (gnus-uu-view-file tar-file)
 990                     (gnus-uu-save-file tar-file)))
 991               (if view
 992                   (gnus-uu-view-file (elt files 2))
 993                 (gnus-uu-save-file (elt files 2)))))))
 994
 995     (gnus-uu-summary-next-subject)
 996
 997     (if (and gnus-uu-use-interactive-view view decoded)
 998         (gnus-uu-do-interactive))
 999
1000     (if (or (not gnus-uu-use-interactive-view) (not decoded))
1001         (gnus-uu-clean-up))))
1002
1003
1004 (defconst gnus-uu-saved-article-name nil)
1005 (defun gnus-uu-save-articles (view marked)
1006   (let (list-of-articles)
1007     (save-excursion
1008       (if (not marked)
1009           (setq list-of-articles (gnus-uu-get-list-of-articles))
1010         (setq list-of-articles (reverse gnus-uu-marked-article-list))
1011         (setq gnus-uu-marked-article-list nil))
1012       (if (not list-of-articles)
1013           (progn
1014             (message "No list of articles")
1015             (sit-for 2))
1016         (setq gnus-uu-saved-article-name
1017               (concat gnus-uu-tmp-dir
1018                       (read-file-name "Enter file name: " gnus-newsgroup-name
1019                                       gnus-newsgroup-name)))
1020         (gnus-uu-add-file gnus-uu-saved-article-name)
1021         (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article)
1022             (gnus-uu-save-file gnus-uu-saved-article-name))
1023         ))))
1024
1025
1026 (defun gnus-uu-save-article (buffer in-state)
1027   (save-excursion
1028     (set-buffer buffer)
1029     (call-process-region
1030      1 (point-max) "sh" nil (get-buffer-create gnus-uu-output-buffer-name)
1031      nil "-c" (concat "cat >> " gnus-uu-saved-article-name)))
1032   'ok)
1033
1034
1035 ;; Binhex
1036 (defconst gnus-uu-binhex-body-line
1037   "^................................................................$")
1038 (defconst gnus-uu-binhex-begin-line
1039   "^:...............................................................$")
1040 (defconst gnus-uu-binhex-end-line
1041   ":$")
1042 (defvar gnus-uu-binhex-article-name nil)
1043
1044
1045 (defun gnus-uu-binhex-and-save (view marked)
1046   (let (list-of-articles)
1047     (save-excursion
1048       (if (not marked)
1049           (setq list-of-articles (gnus-uu-get-list-of-articles))
1050         (setq list-of-articles (reverse gnus-uu-marked-article-list))
1051         (setq gnus-uu-marked-article-list nil))
1052 '      (setq gn-dummy-l list-of-articles)
1053       (if (not list-of-articles)
1054           (progn
1055             (message "No list of articles")
1056             (sit-for 2))
1057         (setq gnus-uu-binhex-article-name
1058               (concat gnus-uu-tmp-dir
1059                       (read-file-name "Enter binhex file name: "
1060                                       gnus-newsgroup-name
1061                                       gnus-newsgroup-name)))
1062         (gnus-uu-add-file gnus-uu-binhex-article-name)
1063         (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article)
1064             (gnus-uu-save-file gnus-uu-binhex-article-name))
1065         ))))
1066
1067
1068 (defun gnus-uu-binhex-article (buffer in-state)
1069   (let ((state 'ok)
1070         start-char)
1071     (save-excursion
1072       (set-buffer buffer)
1073       (goto-char 1)
1074       (if (not (re-search-forward (concat gnus-uu-binhex-begin-line "\\|"
1075                                           gnus-uu-binhex-body-line) nil t))
1076           (setq state 'wrong-type)
1077         (beginning-of-line)
1078         (setq start-char (point))
1079         (if (looking-at gnus-uu-binhex-begin-line)
1080             (setq state 'begin)
1081           (setq state 'middle))
1082         (goto-char (point-max))
1083         (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
1084                                     gnus-uu-binhex-end-line) nil t)
1085         (if (looking-at gnus-uu-binhex-end-line)
1086             (if (eq state 'begin)
1087                 (setq state 'begin-and-end)
1088               (setq state 'end)))
1089         (beginning-of-line)
1090         (forward-line 1)
1091         (append-to-file start-char (point) gnus-uu-binhex-article-name)))
1092     state))
1093
1094
1095 ;; Internal view commands
1096
1097 (defun gnus-uu-view-file (file-name &optional dont-ask)
1098   "This function takes two parameters. The first is name of the file to be
1099 viewed. gnus-uu-view-file will look for an action associated with the file
1100 type of the file. If it finds an appropriate action, the file will be
1101 attempted displayed.
1102
1103 The second parameter specifies if the user is to be asked whether to
1104 save the file if viewing is unsuccessful. `t' means 'do not ask.'
1105
1106 Note that the file given will be deleted by this function, one way or
1107 another. If `gnus-uu-asynchronous' is set, it won't be deleted right
1108 away, but sometime later. If the user is offered to save the file, it'll
1109 be moved to wherever the user wants it.
1110
1111 gnus-uu-view-file returns `t' if viewing is successful."
1112   (let (action did-view
1113         (didnt-want t)
1114         (do-view t))
1115     (setq action
1116           (gnus-uu-choose-action
1117            file-name
1118            (append
1119             (if (and gnus-uu-use-interactive-view
1120                      gnus-uu-user-interactive-view-rules)
1121                 gnus-uu-user-interactive-view-rules
1122               gnus-uu-user-view-rules)
1123             (if (or gnus-uu-ignore-default-view-rules
1124                     (not gnus-uu-use-interactive-view))
1125                 ()
1126               gnus-uu-default-interactive-view-rules-begin)
1127             (if gnus-uu-ignore-default-view-rules
1128                 nil
1129               gnus-uu-default-view-rules)
1130             (if (and gnus-uu-use-interactive-view
1131                      gnus-uu-user-interactive-view-rules-end)
1132                 gnus-uu-user-interactive-view-rules-end
1133                gnus-uu-user-view-rules-end))))
1134
1135            (if (and gnus-uu-use-interactive-view
1136                     (not (string= (or action "") "gnus-uu-archive")))
1137                (gnus-uu-enter-interactive-file (or action "") file-name)
1138
1139              (if action
1140                  (if (string= action "gnus-uu-archive")
1141                      (setq did-view (gnus-uu-treat-archive file-name))
1142
1143                    (if gnus-uu-ask-before-view
1144                        (setq didnt-want
1145                              (or (not
1146                                   (setq do-view
1147                                         (y-or-n-p
1148                                          (format "Do you want to view %s? "
1149                                                  file-name))))
1150                                  didnt-want)))
1151
1152                    (if do-view
1153                        (setq did-view
1154                              (if gnus-uu-asynchronous
1155                                  (gnus-uu-call-asynchronous file-name action)
1156                                (gnus-uu-call-synchronous file-name action))))))
1157
1158              (if (and (not dont-ask) (not gnus-uu-use-interactive-view))
1159                  (progn
1160                    (if (and
1161                         didnt-want
1162                         (or (not action)
1163                             (and (string= action "gnus-uu-archive") (not did-view))))
1164                        (progn
1165                          (message (format "Could find no rule for %s" file-name))
1166                          (sit-for 2)))
1167                    (and (or (not did-view) gnus-uu-view-and-save)
1168                         (y-or-n-p
1169                          (format "Do you want to save the file %s? " file-name))
1170                         (gnus-uu-save-file file-name))))
1171
1172              (if (and (file-exists-p file-name)
1173                       (not gnus-uu-use-interactive-view)
1174                       (or
1175                        (not (and gnus-uu-asynchronous did-view))
1176                        (string= action "gnus-uu-archive")))
1177                  (delete-file file-name)))
1178
1179            did-view))
1180
1181
1182 (defun gnus-uu-call-synchronous (file-name action)
1183   "Takes two parameters: The name of the file to be displayed and
1184 the command to display it with. Returns `t' on success and `nil' if
1185 the file couldn't be displayed."
1186   (let (did-view command)
1187     (save-excursion
1188       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1189       (erase-buffer)
1190       (if (string-match "%s" action)
1191           (setq command (format action (concat "'" file-name "'")))
1192         (setq command (concat action " " (concat "'" file-name "'"))))
1193       (message (format "Viewing with '%s'" command))
1194       (if (not (= 0 (call-process "sh" nil t nil "-c" command)))
1195           (progn
1196             (goto-char 1)
1197             (while (re-search-forward "\n" nil t)
1198               (replace-match " "))
1199             (message (concat "Error: " (buffer-substring 1 (point-max))))
1200             (sit-for 2))
1201         (message "")
1202         (setq did-view t)))
1203     did-view))
1204
1205
1206 (defun gnus-uu-call-asynchronous (file-name action)
1207   "Takes two parameters: The name of the file to be displayed and
1208 the command to display it with. Since the view command is executed
1209 asynchronously, it's kinda hard to decide whether the command succeded
1210 or not, so this function always returns `t'. It also adds \"; rm -f
1211 file-name\" to the end of the execution string, so the file will be
1212 removed after viewing has ended."
1213   (let (command file tmp-file start)
1214     (while (string-match "/" file-name start)
1215       (setq start (1+ (match-beginning 0))))
1216     (setq file (substring file-name start))
1217     (setq tmp-file (concat gnus-uu-tmp-dir file))
1218     (if (string= tmp-file file-name)
1219         ()
1220       (rename-file file-name tmp-file t)
1221       (setq file-name tmp-file))
1222
1223     (if (string-match "%s" action)
1224         (setq command (format action file-name))
1225       (setq command (concat action " " file-name)))
1226     (setq command (format "%s ; rm -f %s" command file-name))
1227     (message (format "Viewing with %s" command))
1228     (start-process "gnus-uu-view"
1229                    nil "sh" "-c" command)
1230     t))
1231
1232
1233 (defun gnus-uu-decode-and-strip (&optional shar use-marked)
1234   "This function does all the main work. It finds out what articles
1235 to grab, grabs them, strips the result and decodes. If any of
1236 these operations fail, it returns `nil', `t' otherwise.
1237 If shar is `t', it will pass this on to gnus-uu-grab-articles
1238 who will (probably) unshar the articles. If use-marked
1239 is non-nil, it won't try to find articles, but use the marked list."
1240   (let (list-of-articles)
1241     (save-excursion
1242
1243       (if use-marked
1244           (progn (if (eq gnus-uu-marked-article-list ())
1245                 (message "No articles marked")
1246               (setq list-of-articles (reverse gnus-uu-marked-article-list))
1247               (gnus-uu-unmark-all-articles)))
1248         (setq list-of-articles (gnus-uu-get-list-of-articles)))
1249
1250       (and list-of-articles
1251            (gnus-uu-grab-articles list-of-articles
1252                                   (if shar
1253                                       'gnus-uu-unshar-article
1254                                     'gnus-uu-uustrip-article-as))))))
1255
1256
1257 (defun gnus-uu-reginize-string (string)
1258   "Takes a string and puts a \\ in front of every special character;
1259 ignores any leading \"version numbers\"
1260 thingies that they use in the comp.binaries groups, and either replaces
1261 anything that looks like \"2/3\" with \"[0-9]+/[0-9]+\" or, if it can't find
1262 something like that, replaces the last two numbers with \"[0-9]+\". This,
1263 in my experience, should get most postings of a series."
1264   (let ((count 2)
1265         (vernum "v[0-9][0-9][a-z][0-9]+:")
1266         reg beg)
1267     (save-excursion
1268       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1269       (erase-buffer)
1270       (insert (regexp-quote string))
1271       (setq beg 1)
1272
1273       (setq case-fold-search nil)
1274       (goto-char 1)
1275       (if (looking-at vernum)
1276           (progn
1277             (replace-match vernum t t)
1278             (setq beg (length vernum))))
1279
1280       (goto-char beg)
1281       (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
1282           (replace-match " [0-9]+/[0-9]+")
1283
1284         (goto-char beg)
1285         (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
1286             (replace-match "[0-9]+ of [0-9]+")
1287
1288           (end-of-line)
1289           (while (and (re-search-backward "[0-9]" nil t) (> count 0))
1290             (while (and
1291                     (looking-at "[0-9]")
1292                     (< 1 (goto-char (1- (point))))))
1293             (re-search-forward "[0-9]+" nil t)
1294             (replace-match "[0-9]+")
1295             (backward-char 5)
1296             (setq count (1- count)))))
1297
1298       (goto-char beg)
1299       (while (re-search-forward "[ \t]+" nil t)
1300         (replace-match "[ \t]*" t t))
1301
1302       (buffer-substring 1 (point-max)))))
1303
1304
1305 (defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread)
1306   "Finds all articles that matches the regular expression given.
1307 Returns the resulting list."
1308   (let (beg end reg-subject list-of-subjects list-of-numbers art-num)
1309     (save-excursion
1310
1311 ; If the subject is not given, this function looks at the current subject
1312 ; and takes that.
1313
1314       (if subject
1315           (setq reg-subject subject)
1316         (end-of-line)
1317         (setq end (point))
1318         (beginning-of-line)
1319         (if (not (re-search-forward "\\] " end t))
1320             (progn (message "No valid subject chosen") (sit-for 2))
1321           (setq subject (buffer-substring (point) end))
1322           (setq reg-subject
1323                 (concat "\\[.*\\] " (gnus-uu-reginize-string subject)))))
1324
1325 ;      (message reg-subject)(sleep-for 2)
1326
1327       (if reg-subject
1328           (progn
1329
1330 ; Collect all subjects matching reg-subject.
1331
1332             (let ((case-fold-search t))
1333               (setq case-fold-search t)
1334               (goto-char 1)
1335               (while (re-search-forward reg-subject nil t)
1336                 (beginning-of-line)
1337                 (setq beg (point))
1338                 (if (or (not only-unread) (looking-at " \\|-"))
1339                     (progn
1340                       (end-of-line)
1341                       (setq list-of-subjects (cons
1342                                               (buffer-substring beg (point))
1343                                               list-of-subjects)))
1344                   (end-of-line))))
1345
1346 ; Expand all numbers in all the subjects: (hi9 -> hi0009, etc).
1347
1348             (setq list-of-subjects (gnus-uu-expand-numbers list-of-subjects))
1349
1350 ; Sort the subjects.
1351
1352             (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<))
1353
1354 ; Get the article numbers from the sorted list of subjects.
1355
1356             (while list-of-subjects
1357               (setq art-num (gnus-uu-article-number (car list-of-subjects)))
1358               (if mark-articles (gnus-summary-mark-as-read art-num ?#))
1359               (setq list-of-numbers (cons art-num list-of-numbers))
1360               (setq list-of-subjects (cdr list-of-subjects)))
1361
1362             (setq list-of-numbers (nreverse list-of-numbers))
1363
1364             (if (not list-of-numbers)
1365                 (progn
1366                   (message (concat "No subjects matched " subject))
1367                   (sit-for 2)))))
1368
1369       list-of-numbers)))
1370
1371
1372 (defun gnus-uu-expand-numbers (string-list)
1373   "Takes a list of strings and \"expands\" all numbers in all the strings.
1374 That is, this function makes all numbers equal length by prepending lots
1375 of zeroes before each number. This is to ease later sorting to find out
1376 what sequence the articles are supposed to be decoded in. Returns the list
1377 of expanded strings."
1378   (let (string out-list pos num)
1379     (save-excursion
1380       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1381       (while string-list
1382         (erase-buffer)
1383         (setq string (car string-list))
1384         (setq string-list (cdr string-list))
1385         (insert string)
1386         (goto-char 1)
1387         (while (re-search-forward "[ \t]+" nil t)
1388           (replace-match " "))
1389         (goto-char 1)
1390         (while (re-search-forward "[A-Za-z]" nil t)
1391           (replace-match "a" t t))
1392
1393         (goto-char 1)
1394         (if (not (search-forward "] " nil t))
1395             ()
1396           (while (re-search-forward "[0-9]+" nil t)
1397             (replace-match
1398              (format "%06d"
1399                      (string-to-int (buffer-substring
1400                                      (match-beginning 0) (match-end 0))))))
1401           (setq string (buffer-substring 1 (point-max)))
1402           (setq out-list (cons string out-list)))))
1403     out-list))
1404
1405
1406 (defun gnus-uu-string< (string1 string2)
1407   "Used in a sort for finding out what string is bigger, but ignoring
1408 everything before the subject part."
1409   (string< (substring string1 (string-match "\\] " string1))
1410            (substring string2 (string-match "\\] " string2))))
1411
1412
1413 ;; gnus-uu-grab-article
1414 ;;
1415 ;; This is the general multi-article treatment function.
1416 ;; It takes a list of articles to be grabbed and a function
1417 ;; to apply to each article. It puts the result in
1418 ;; gnus-uu-result-buffer.
1419 ;;
1420 ;; The function to be called should take two parameters.
1421 ;; The first is the buffer that has the article that should
1422 ;; be treated. The function should leave the result in this
1423 ;; buffer as well. This result is then appended on to the
1424 ;; gnus-uu-result-buffer.
1425 ;; The second parameter is the state of the list of articles,
1426 ;; and can have three values: 'start, 'middle and 'end.
1427 ;; The function can have several return values.
1428 ;; 'error if there was an error while treating.
1429 ;; 'end if the last article has been sighted.
1430 ;; 'begin-and-end if the article is both the beginning and
1431 ;;   the end. All these three return values results in
1432 ;;   gnus-uu-grab-articles stopping traversing of the list
1433 ;;   of articles.
1434 ;; 'middle if the article is a "middle" article.
1435 ;; 'ok if everything is ok.
1436
1437 (defvar gnus-uu-has-been-grabbed nil)
1438
1439 (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
1440   (let (art)
1441     (if (or (not gnus-uu-has-been-grabbed)
1442             (not gnus-uu-unmark-articles-not-decoded))
1443         ()
1444       (if dont-unmark-last-article
1445           (progn
1446             (setq art (car gnus-uu-has-been-grabbed))
1447             (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))))
1448       (while gnus-uu-has-been-grabbed
1449         (gnus-summary-mark-as-unread (car gnus-uu-has-been-grabbed) t)
1450         (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
1451       (if dont-unmark-last-article
1452           (setq gnus-uu-has-been-grabbed (list art)))
1453       )))
1454
1455
1456 (defun gnus-uu-grab-articles (list-of-articles process-function)
1457   "This function takes a list of articles and a function to apply
1458 to each article grabbed. The result of the function is appended
1459 on to gnus-uu-result-buffer.
1460
1461 This function returns `t' if the grabbing and the process-function
1462 has been successful and `nil' otherwise."
1463   (let ((result-buffer (get-buffer-create gnus-uu-result-buffer))
1464         (state 'first)
1465         (process-state 'ok)
1466         (result t)
1467         (wrong-type t)
1468         (has-been-begin nil)
1469         (article nil))
1470
1471     (save-excursion
1472       (set-buffer result-buffer)
1473       (erase-buffer))
1474     (setq gnus-uu-has-been-grabbed nil)
1475     (while (and list-of-articles
1476                 (not (eq process-state 'end))
1477                 (not (eq process-state 'begin-and-end))
1478                 (not (eq process-state 'error)))
1479       (setq article (car list-of-articles))
1480       (setq list-of-articles (cdr list-of-articles))
1481       (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed))
1482
1483       (if (eq list-of-articles ()) (setq state 'last))
1484
1485       (message (format "Getting article %d" article))
1486       (if (not (= (or gnus-current-article 0) article))
1487           (gnus-summary-display-article article))
1488       (gnus-summary-mark-as-read article)
1489
1490       (save-excursion
1491         (set-buffer gnus-article-buffer)
1492         (widen))
1493
1494       (setq process-state (funcall process-function gnus-article-buffer state))
1495
1496       (if (or (eq process-state 'begin) (eq process-state 'begin-and-end)
1497               (eq process-state 'ok))
1498           (setq has-been-begin t))
1499
1500       (if (not (eq process-state 'wrong-type))
1501           (setq wrong-type nil)
1502         (if gnus-uu-unmark-articles-not-decoded
1503             (gnus-summary-mark-as-unread article t)))
1504
1505       (if gnus-uu-do-sloppy-uudecode
1506           (setq wrong-type nil))
1507
1508       (if (and (not has-been-begin)
1509                (not gnus-uu-do-sloppy-uudecode)
1510                (or (eq process-state 'end)
1511                    (eq process-state 'middle)))
1512           (progn
1513             (setq process-state 'error)
1514             (message "No begin part at the beginning")
1515             (sit-for 2))
1516         (setq state 'middle)))
1517
1518     (if (and (not has-been-begin) (not gnus-uu-do-sloppy-uudecode))
1519         (progn
1520           (setq result nil)
1521           (message "Wrong type file")
1522           (sit-for 2))
1523       (if (eq process-state 'error)
1524           (setq result nil)
1525         (if (not (or (eq process-state 'ok)
1526                      (eq process-state 'end)
1527                      (eq process-state 'begin-and-end)))
1528             (progn
1529               (if (not gnus-uu-do-sloppy-uudecode)
1530                   (progn
1531                     (message "End of articles reached before end of file")
1532                     (sit-for 2)))
1533               (gnus-uu-unmark-list-of-grabbed)
1534               (setq result nil)))))
1535     (setq gnus-uu-rest-of-articles list-of-articles)
1536     result))
1537
1538
1539 (defun gnus-uu-uudecode-sentinel (process event)
1540 ;  (message "Process '%s' has received event '%s'" process event)
1541 ;  (sit-for 2)
1542   (delete-process (get-process process)))
1543
1544
1545 (defun gnus-uu-uustrip-article-as (process-buffer in-state)
1546   (let ((state 'ok)
1547         (process-connection-type nil)
1548         start-char pst name-beg name-end buf-state)
1549     (save-excursion
1550       (set-buffer process-buffer)
1551       (setq buf-state buffer-read-only)
1552       (setq buffer-read-only nil)
1553
1554       (goto-char 1)
1555
1556       (if gnus-uu-kill-carriage-return
1557           (progn
1558             (while (search-forward "
" nil t)
1559               (delete-backward-char 1))
1560             (goto-char 1)))
1561
1562       (if (not (re-search-forward
1563                 (concat gnus-uu-begin-string "\\|" gnus-uu-body-line) nil t))
1564             (setq state 'wrong-type)
1565
1566         (beginning-of-line)
1567         (setq start-char (point))
1568
1569         (if (looking-at gnus-uu-begin-string)
1570             (progn
1571               (setq name-end (match-end 1))
1572               (goto-char (setq name-beg (match-beginning 1)))
1573               (while (re-search-forward "/" name-end t)
1574                 (replace-match "-"))
1575               (setq gnus-uu-file-name (buffer-substring name-beg name-end))
1576               (setq pst (process-status
1577                          (or gnus-uu-uudecode-process "nevair")))
1578               (if (or (eq pst 'stop) (eq pst 'run))
1579                   (progn
1580                     (delete-process gnus-uu-uudecode-process)
1581                     (gnus-uu-unmark-list-of-grabbed t)))
1582               (setq gnus-uu-uudecode-process
1583                     (start-process
1584                      "*uudecode*"
1585                      (get-buffer-create gnus-uu-output-buffer-name)
1586                      "sh" "-c"
1587                      (format "cd %s ; uudecode" gnus-uu-tmp-dir)))
1588               (set-process-sentinel
1589                gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
1590               (setq state 'begin)
1591               (gnus-uu-add-file (concat gnus-uu-tmp-dir gnus-uu-file-name)))
1592           (setq state 'middle))
1593
1594         (goto-char (point-max))
1595         (re-search-backward
1596          (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t)
1597         (if (looking-at gnus-uu-end-string)
1598             (if (eq state 'begin)
1599                 (setq state 'begin-and-end)
1600               (setq state 'end)))
1601         (forward-line 1)
1602
1603         (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
1604         (if (or (eq pst 'run) (eq pst 'stop))
1605             (progn
1606               (gnus-uu-check-correct-stripped-uucode start-char (point))
1607               (condition-case err
1608                   (process-send-region gnus-uu-uudecode-process start-char
1609                                        (point))
1610                 (error
1611                  (progn
1612                    (setq state 'wrong-type)
1613                    (delete-process gnus-uu-uudecode-process)))))
1614           (setq state 'wrong-type)))
1615       (setq buffer-read-only buf-state))
1616     state))
1617
1618
1619 (defun gnus-uu-unshar-article (process-buffer in-state)
1620   "This function is used by gnus-uu-grab-articles to treat
1621 a shared article."
1622   (let ((state 'ok)
1623         start-char)
1624     (save-excursion
1625      (set-buffer process-buffer)
1626      (goto-char 1)
1627      (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
1628          (setq state 'wrong-type)
1629        (beginning-of-line)
1630        (setq start-char (point))
1631        (call-process-region
1632         start-char (point-max) "sh" nil
1633         (get-buffer-create gnus-uu-output-buffer-name) nil
1634         "-c" (concat "cd " gnus-uu-shar-directory " ; sh"))))
1635     state))
1636
1637
1638 (defun gnus-uu-find-name-in-shar ()
1639   "Returns the name of what the shar file is going to unpack."
1640   (let ((oldpoint (point))
1641         res)
1642     (goto-char 1)
1643     (if (re-search-forward gnus-uu-shar-name-marker nil t)
1644         (setq res (buffer-substring (match-beginning 1) (match-end 1))))
1645     (goto-char oldpoint)
1646     res))
1647
1648
1649 (defun gnus-uu-article-number (subject)
1650   "Returns the article number of the given subject."
1651   (let (end)
1652     (string-match "[0-9]+[^0-9]" subject 1)
1653     (setq end (match-end 0))
1654     (string-to-int
1655      (substring subject (string-match "[0-9]" subject 1) end))))
1656
1657
1658 (defun gnus-uu-decode (directory)
1659   "UUdecodes everything in the buffer and returns the name of the resulting
1660 file."
1661   (let ((command (concat "cd " directory " ; uudecode"))
1662         file-name)
1663     (save-excursion
1664       (message "Uudecoding...")
1665       (set-buffer (get-buffer-create gnus-uu-result-buffer))
1666       (setq file-name (concat gnus-uu-tmp-dir gnus-uu-file-name))
1667       (gnus-uu-add-file file-name)
1668       (call-process-region 1 (point-max) "sh" nil t nil "-c" command)
1669       file-name)))
1670
1671
1672 (defun gnus-uu-choose-action (file-name file-action-list)
1673   "Chooses what action to perform given the name and gnus-uu-file-action-list.
1674 Returns either nil if no action is found, or the name of the command
1675 to run if such a rule is found."
1676   (let ((action-list (copy-sequence file-action-list))
1677         rule action)
1678     (while (not (or (eq action-list ()) action))
1679       (setq rule (car action-list))
1680       (setq action-list (cdr action-list))
1681       (if (string-match (car rule) file-name)
1682           (setq action (car (cdr rule)))))
1683     action))
1684
1685
1686 (defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing)
1687   "Moves the file from the tmp directory to where the user wants it."
1688   (let (dir file-name command)
1689     (string-match "/[^/]*$" from-file-name)
1690     (setq file-name (substring from-file-name (1+ (match-beginning 0))))
1691     (if default-dir
1692         (setq dir default-dir)
1693       (setq dir (gnus-uu-read-directory "Where do you want the file? ")))
1694     (if (and (not ignore-existing) (file-exists-p (concat dir file-name)))
1695         (progn
1696           (message (concat "There already is a file called " file-name))
1697           (sit-for 2)
1698           (setq file-name
1699                 (read-file-name "Give a new name: " dir (concat dir file-name)
1700                             nil file-name)))
1701       (setq file-name (concat dir file-name)))
1702     (rename-file from-file-name file-name t)))
1703
1704
1705 (defun gnus-uu-read-directory (prompt &optional default)
1706   (let (dir ok create)
1707     (while (not ok)
1708       (setq ok t)
1709       (setq dir (if default default
1710                   (read-file-name prompt gnus-uu-current-save-dir
1711                                   gnus-uu-current-save-dir)))
1712       (while (string-match "/$" dir)
1713         (setq dir (substring dir 0 (match-beginning 0))))
1714       (if (file-exists-p dir)
1715           (if (not (file-directory-p dir))
1716               (progn
1717                 (setq ok nil)
1718                 (message "%s is a file" dir)
1719                 (sit-for 2)))
1720         (setq create ?o)
1721         (while (not (or (= create ?y) (= create ?n)))
1722           (message "%s: No such directory. Do you want to create it? (y/n)"
1723                    dir)
1724           (setq create (read-char)))
1725         (if (= create ?y) (make-directory dir))))
1726     (setq gnus-uu-current-save-dir (concat dir "/"))))
1727
1728
1729 (defun gnus-uu-treat-archive (file-name)
1730   "Unpacks an archive and views all the files in it. Returns `t' if
1731 viewing one or more files is successful."
1732   (let ((arc-dir (make-temp-name
1733                   (concat gnus-uu-tmp-dir "gnusuu")))
1734         action command files file did-view short-file-name
1735         error-during-unarching)
1736     (setq action (gnus-uu-choose-action
1737                   file-name (append gnus-uu-user-archive-rules
1738                                     (if gnus-uu-ignore-default-archive-rules
1739                                         nil
1740                                       gnus-uu-default-archive-rules))))
1741     (if (not action)
1742         (progn (message (format "No unpackers for the file %s" file-name))
1743                (sit-for 2))
1744       (string-match "/[^/]*$" file-name)
1745       (setq short-file-name (substring file-name (1+ (match-beginning 0))))
1746       (setq command (format "%s %s %s ; cd %s ; %s %s "
1747                             (if (or (string= action "uncompress")
1748                                     (string= action "gunzip"))
1749                                 "cp"
1750                               "mv")
1751                             file-name arc-dir
1752                             arc-dir
1753                             action short-file-name))
1754
1755       (make-directory arc-dir)
1756       (gnus-uu-add-file arc-dir)
1757
1758       (save-excursion
1759         (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
1760         (erase-buffer))
1761
1762       (message (format "Unpacking with %s..." action))
1763
1764       (if (= 0 (call-process "sh" nil
1765                              (get-buffer-create gnus-uu-output-buffer-name)
1766                              nil "-c" command))
1767           (message "")
1768         (message "Error during unpacking of archive")
1769         (sit-for 2)
1770         (sit-for 2)
1771         (setq error-during-unarching t))
1772
1773       (if (not (or (string= action "uncompress")
1774                    (string= action "gunzip")))
1775           (call-process "sh" nil (get-buffer gnus-uu-output-buffer-name)
1776                         nil "-c" (format "mv %s/%s %s"
1777                                          arc-dir short-file-name
1778                                          gnus-uu-tmp-dir)))
1779       (gnus-uu-add-file (concat gnus-uu-tmp-dir short-file-name))
1780
1781       (setq did-view
1782             (or (gnus-uu-show-directory arc-dir gnus-uu-use-interactive-view)
1783                 did-view))
1784
1785       (if (and (not gnus-uu-use-interactive-view)
1786                (file-directory-p arc-dir))
1787           (delete-directory arc-dir)))
1788
1789     did-view))
1790
1791
1792 (defun gnus-uu-show-directory (dir &optional dont-delete-files)
1793   "Tries to view all the files in the given directory. Returns `t' if
1794 viewing one or more files is successful."
1795   (let (files file did-view)
1796     (setq files (directory-files dir t))
1797     (setq gnus-uu-generated-file-list
1798           (append files gnus-uu-generated-file-list))
1799     (while files
1800       (setq file (car files))
1801       (setq files (cdr files))
1802       (if (and (not (string-match "/\\.$" file))
1803                (not (string-match "/\\.\\.$" file)))
1804           (progn
1805             (set-file-modes file 448)
1806             (if (file-directory-p file)
1807                 (setq did-view (or (gnus-uu-show-directory file
1808                                                            dont-delete-files)
1809                                    did-view))
1810               (setq did-view (or (gnus-uu-view-file file t) did-view))
1811               (if (and (not dont-delete-files) (file-exists-p file))
1812                        (delete-file file))))))
1813     (if (not dont-delete-files) (delete-directory dir))
1814     did-view))
1815
1816
1817 ;; Manual marking
1818
1819 (defun gnus-uu-enter-mark-in-list ()
1820   (let (article beg)
1821     (beginning-of-line)
1822     (setq beg (point))
1823     (end-of-line)
1824     (setq article (gnus-uu-article-number
1825                    (buffer-substring beg (point))))
1826     (message (format "Adding article %d to list" article))
1827     (setq gnus-uu-marked-article-list
1828           (cons article gnus-uu-marked-article-list))))
1829
1830 (defun gnus-uu-mark-article ()
1831   "Marks the current article to be decoded later."
1832   (interactive)
1833   (gnus-uu-enter-mark-in-list)
1834   (gnus-summary-mark-as-read nil ?#)
1835   (gnus-summary-next-subject 1 nil))
1836
1837 (defun gnus-uu-unmark-article ()
1838   "Unmarks the current article."
1839   (interactive)
1840   (let ((in (copy-sequence gnus-uu-marked-article-list))
1841         out article beg found
1842         (old-point (point)))
1843     (beginning-of-line)
1844       (setq beg (point))
1845       (end-of-line)
1846       (setq article (gnus-uu-article-number (buffer-substring beg (point))))
1847       (message (format "Removing article %d" article))
1848       (while in
1849         (if (not (= (car in) article))
1850             (setq out (cons (car in) out))
1851           (setq found t)
1852           (message (format "Removing article %d" article)))
1853         (setq in (cdr in)))
1854       (if (not found) (message "Not a marked article."))
1855       (setq gnus-uu-marked-article-list (reverse out))
1856       (gnus-summary-mark-as-unread nil t)
1857       (gnus-summary-next-subject 1 nil)))
1858
1859
1860 (defun gnus-uu-unmark-all-articles ()
1861   "Removes the mark from all articles marked for decoding."
1862   (interactive)
1863   (let ((articles (copy-sequence gnus-uu-marked-article-list)))
1864     (while articles
1865       (gnus-summary-goto-subject (car articles))
1866       (gnus-summary-mark-as-unread nil t)
1867       (setq articles (cdr articles)))
1868     (setq gnus-uu-marked-article-list ())))
1869
1870 (defun gnus-uu-mark-by-regexp ()
1871   "Asks for a regular expression and marks all articles that match for later decoding."
1872   (interactive)
1873   (let (exp)
1874     (setq exp (read-from-minibuffer "Enter regular expression: "))
1875     (setq gnus-uu-marked-article-list
1876           (reverse (gnus-uu-get-list-of-articles exp t)))
1877     (message "")))
1878
1879
1880 ;; Various
1881
1882 (defun gnus-uu-check-correct-stripped-uucode (start end)
1883   (let (found beg length short)
1884     (if (not gnus-uu-correct-stripped-uucode)
1885         ()
1886       (goto-char start)
1887       (while (< (point) end)
1888         (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string))
1889             ()
1890           (if (not found)
1891               (progn
1892                 (beginning-of-line)
1893                 (setq beg (point))
1894                 (end-of-line)
1895                 (setq length (- (point) beg))))
1896           (beginning-of-line)
1897           (setq beg (point))
1898           (end-of-line)
1899           (if (not (= length (- (point) beg)))
1900               (insert (make-string (- length (- (point) beg))) ? )))
1901         (forward-line 1)))))
1902
1903 (defun gnus-uu-initialize ()
1904   (if (not gnus-uu-use-interactive-view)
1905       ()
1906     (save-excursion
1907       (setq gnus-uu-interactive-file-list nil)
1908       (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name))
1909       (erase-buffer)
1910       (gnus-uu-mode)
1911       (insert
1912        "# Press return to execute a command.
1913 # Press `C-c C-c' to exit interactive view.
1914
1915 "))))
1916
1917
1918 (defun gnus-uu-clean-up ()
1919   "Kills the temporary uu buffers."
1920   (let (buf pst)
1921     (setq gnus-uu-do-sloppy-uudecode nil)
1922     (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
1923     (if (or (eq pst 'stop) (eq pst 'run))
1924         (delete-process gnus-uu-uudecode-process))
1925     (and (not gnus-uu-asynchronous)
1926          (setq buf (get-buffer gnus-uu-output-buffer-name))
1927          (kill-buffer buf))
1928     (and (setq buf (get-buffer gnus-uu-result-buffer))
1929          (kill-buffer buf))))
1930
1931
1932 (defun gnus-uu-check-for-generated-files ()
1933   "Deletes any generated files that hasn't been deleted, if, for
1934 instance, the user terminated decoding with `C-g'."
1935   (let (file)
1936     (while gnus-uu-generated-file-list
1937       (setq file (car gnus-uu-generated-file-list))
1938       (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list))
1939       (if (not (string-match "/\\.[\\.]?$" file))
1940           (progn
1941             (if (file-directory-p file)
1942                 (delete-directory file)
1943               (if (file-exists-p file)
1944                   (delete-file file))))))))
1945
1946
1947 (defun gnus-uu-add-file (file)
1948   (setq gnus-uu-generated-file-list
1949         (cons file gnus-uu-generated-file-list)))
1950
1951 (defun gnus-uu-summary-next-subject ()
1952   (if (not (gnus-summary-search-forward t))
1953       (progn
1954         (goto-char 1)
1955         (sit-for 0)
1956         (goto-char (point-max))
1957         (forward-line -1)
1958         (beginning-of-line)
1959         (search-forward ":" nil t)))
1960   (sit-for 0)
1961   (gnus-summary-recenter))
1962
1963
1964 ;; Initializing
1965
1966 (add-hook 'gnus-exit-group-hook
1967       '(lambda ()
1968          (gnus-uu-clean-up)
1969          (setq gnus-uu-marked-article-list nil)
1970          (gnus-uu-check-for-generated-files)))
1971
1972
1973 ;; Interactive exec mode
1974
1975 (defvar gnus-uu-output-window nil)
1976 (defvar gnus-uu-mode-hook nil)
1977 (defvar gnus-uu-mode-map nil)
1978
1979 (defun gnus-uu-do-interactive ()
1980   (let (int-buffer out-buf)
1981     (set-buffer
1982      (setq int-buffer (get-buffer gnus-uu-interactive-buffer-name)))
1983     (switch-to-buffer-other-window int-buffer)
1984     (pop-to-buffer int-buffer)
1985     (setq gnus-uu-output-window
1986           (split-window nil (- (window-height) gnus-uu-output-window-height)))
1987     (set-window-buffer gnus-uu-output-window
1988                        (setq out-buf
1989                              (get-buffer-create gnus-uu-output-buffer-name)))
1990     (save-excursion (set-buffer out-buf) (erase-buffer))
1991     (goto-char 1)
1992     (forward-line 3)
1993     (run-hooks 'gnus-uu-mode-hook)))
1994
1995
1996 (defun gnus-uu-enter-interactive-file (action file)
1997   (let (command)
1998     (save-excursion
1999       (setq gnus-uu-interactive-file-list
2000             (cons file gnus-uu-interactive-file-list))
2001       (set-buffer (get-buffer gnus-uu-interactive-buffer-name))
2002       (if (string-match "%s" action)
2003           (setq command (format action (concat "'" file "'")))
2004         (setq command (concat action " " (concat "'" file "'"))))
2005
2006       (insert (format "%s\n" command)))))
2007
2008
2009 (defun gnus-uu-interactive-execute ()
2010   (interactive)
2011   (let (beg out-buf command)
2012     (beginning-of-line)
2013     (setq beg (point))
2014     (end-of-line)
2015     (setq command (buffer-substring beg (point)))
2016     (setq out-buf (get-buffer-create gnus-uu-output-buffer-name))
2017     (save-excursion
2018       (set-buffer out-buf)
2019       (erase-buffer)
2020       (insert (format "$ %s \n\n" command)))
2021     (message "Executing...")
2022     (if gnus-uu-asynchronous
2023         (start-process "gnus-uu-view" out-buf "sh" "-c" command)
2024       (call-process "sh" nil out-buf nil "-c" command)
2025       (message ""))
2026     (forward-line 1)
2027     (beginning-of-line)))
2028
2029
2030 (defun gnus-uu-interactive-end ()
2031   "This function ends interactive view mode and returns to summary mode."
2032   (interactive)
2033   (let (buf)
2034     (delete-window gnus-uu-output-window)
2035     (gnus-uu-clean-up)
2036     (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files))
2037     (setq buf (get-buffer gnus-uu-interactive-buffer-name))
2038     (if gnus-article-buffer (switch-to-buffer gnus-article-buffer))
2039     (if buf (kill-buffer buf))
2040     (pop-to-buffer gnus-summary-buffer)))
2041
2042
2043 (if gnus-uu-mode-map
2044     ()
2045   (setq gnus-uu-mode-map (make-sparse-keymap))
2046   (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
2047   (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
2048   (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
2049   (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
2050   (define-key gnus-uu-mode-map "\C-cs"
2051     'gnus-uu-interactive-save-current-file)
2052   (define-key gnus-uu-mode-map "\C-c\C-s"
2053     'gnus-uu-interactive-save-current-file-silent)
2054   (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files)
2055   (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file))
2056
2057
2058 (defun gnus-uu-interactive-save-original-file ()
2059   (interactive)
2060   (let (file)
2061     (if (file-exists-p
2062          (setq file (concat gnus-uu-tmp-dir
2063                             (or gnus-uu-file-name gnus-uu-shar-file-name))))
2064         (gnus-uu-save-file file)
2065       (message "Already saved."))))
2066
2067
2068 (defun gnus-uu-interactive-save-current-file-silent ()
2069   "hei"
2070   (interactive)
2071   (gnus-uu-interactive-save-current-file t))
2072
2073 (defun gnus-uu-interactive-save-current-file (&optional dont-ask silent)
2074   "Saves the file referred to on the current line."
2075   (interactive)
2076   (let (files beg line file)
2077     (setq files (copy-sequence gnus-uu-interactive-file-list))
2078     (beginning-of-line)
2079     (setq beg (point))
2080     (end-of-line)
2081     (setq line (buffer-substring beg (point)))
2082     (while (and files
2083                 (not (string-match
2084                       (concat "" (regexp-quote (setq file (car files))) "")
2085                       line)))
2086       (setq files (cdr files)))
2087     (beginning-of-line)
2088     (forward-line 1)
2089     (if (not files)
2090         (if (not silent)
2091             (progn (message "Could not find file") (sit-for 2)))
2092       (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent)
2093       (delete-region beg (point)))))
2094
2095
2096 (defun gnus-uu-interactive-save-all-files ()
2097   "Saves all files referred to on the current line."
2098   (interactive)
2099   (let (dir)
2100     (goto-char 1)
2101     (setq dir (gnus-uu-read-directory "Where do you want the files? "))
2102     (while (not (eobp))
2103       (gnus-uu-interactive-save-current-file t t))))
2104
2105 (defun gnus-uu-mode ()
2106   "Major mode for editing view commands in gnus-uu.
2107
2108
2109 Commands:
2110 Return, C-c C-v, C-c C-x        Execute the current command
2111 C-c C-c                         End interactive mode
2112 C-c s                           Save the current file
2113 C-c C-s                         Save the current file without asking
2114                                 where to put it
2115 C-c C-a                         Save all files
2116 C-c C-o                         Save the original file: If the files
2117                                 originated in an archive, the archive
2118                                 file is saved.
2119 "
2120   (interactive)
2121   (kill-all-local-variables)
2122   (use-local-map gnus-uu-mode-map)
2123   (setq mode-name "gnus-uu")
2124   (setq major-mode 'gnus-uu-mode)
2125 )
2126
2127   (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
2128   (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
2129   (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
2130   (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
2131   (define-key gnus-uu-mode-map "\C-cs"
2132     'gnus-uu-interactive-save-current-file)
2133   (define-key gnus-uu-mode-map "\C-c\C-s"
2134     'gnus-uu-interactive-save-current-file-silent)
2135   (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files)
2136   (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)
2137
2138 (provide 'gnus-uu)
2139
2140 ;; gnus-uu.el ends here