Mercurial > emacs

comparison lisp/gnus/gnus-uu.el @ 56927:55fd4f77387a after-merge-gnus-5_10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0 tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS
author Miles Bader <miles@gnu.org>
date Sat, 04 Sep 2004 13:13:48 +0000
parents 695cf19ef79e
children 88db2adda4b7 cce1c0ee76ee
comparison
equal deleted inserted replaced
56926:f8e248e9a717 56927:55fd4f77387a
1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus 1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
2 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
3 ;; 2001 Free Software Foundation, Inc. 3 ;; 2001, 2002, 2003 Free Software Foundation, Inc.
4 4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Created: 2 Oct 1993 6 ;; Created: 2 Oct 1993
7 ;; Keyword: news 7 ;; Keyword: news
8 8
297 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" 297 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
298 "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" 298 "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
299 "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" 299 "^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
300 "^Content-ID:") 300 "^Content-ID:")
301 "*List of regexps to match headers included in digested messages. 301 "*List of regexps to match headers included in digested messages.
302 The headers will be included in the sequence they are matched." 302 The headers will be included in the sequence they are matched. If nil
303 include all headers."
303 :group 'gnus-extract 304 :group 'gnus-extract
304 :type '(repeat regexp)) 305 :type '(repeat regexp))
305 306
306 (defcustom gnus-uu-save-separate-articles nil 307 (defcustom gnus-uu-save-separate-articles nil
307 "*Non-nil means that gnus-uu will save articles in separate files." 308 "*Non-nil means that gnus-uu will save articles in separate files."
319 320
320 ;; Internal variables 321 ;; Internal variables
321 322
322 (defvar gnus-uu-saved-article-name nil) 323 (defvar gnus-uu-saved-article-name nil)
323 324
324 (defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") 325 (defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
325 (defvar gnus-uu-end-string "^end[ \t]*$") 326 (defvar gnus-uu-end-string "^end[ \t]*$")
326 327
327 (defvar gnus-uu-body-line "^M") 328 (defvar gnus-uu-body-line "^M")
328 (let ((i 61)) 329 (let ((i 61))
329 (while (> (setq i (1- i)) 0) 330 (while (> (setq i (1- i)) 0)
334 335
335 (defvar gnus-uu-shar-begin-string "^#! */bin/sh") 336 (defvar gnus-uu-shar-begin-string "^#! */bin/sh")
336 337
337 (defvar gnus-uu-shar-file-name nil) 338 (defvar gnus-uu-shar-file-name nil)
338 (defvar gnus-uu-shar-name-marker 339 (defvar gnus-uu-shar-name-marker
339 "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") 340 "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
340 341
341 (defvar gnus-uu-postscript-begin-string "^%!PS-") 342 (defvar gnus-uu-postscript-begin-string "^%!PS-")
342 (defvar gnus-uu-postscript-end-string "^%%EOF$") 343 (defvar gnus-uu-postscript-end-string "^%%EOF$")
343 344
344 (defvar gnus-uu-file-name nil) 345 (defvar gnus-uu-file-name nil)
350 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*") 351 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
351 352
352 (defvar gnus-uu-default-dir gnus-article-save-directory) 353 (defvar gnus-uu-default-dir gnus-article-save-directory)
353 (defvar gnus-uu-digest-from-subject nil) 354 (defvar gnus-uu-digest-from-subject nil)
354 (defvar gnus-uu-digest-buffer nil) 355 (defvar gnus-uu-digest-buffer nil)
355
356 ;; Keymaps
357
358 (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
359 "p" gnus-summary-mark-as-processable
360 "u" gnus-summary-unmark-as-processable
361 "U" gnus-summary-unmark-all-processable
362 "v" gnus-uu-mark-over
363 "s" gnus-uu-mark-series
364 "r" gnus-uu-mark-region
365 "g" gnus-uu-unmark-region
366 "R" gnus-uu-mark-by-regexp
367 "G" gnus-uu-unmark-by-regexp
368 "t" gnus-uu-mark-thread
369 "T" gnus-uu-unmark-thread
370 "a" gnus-uu-mark-all
371 "b" gnus-uu-mark-buffer
372 "S" gnus-uu-mark-sparse
373 "k" gnus-summary-kill-process-mark
374 "y" gnus-summary-yank-process-mark
375 "w" gnus-summary-save-process-mark
376 "i" gnus-uu-invert-processable)
377
378 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
379 ;;"x" gnus-uu-extract-any
380 "m" gnus-summary-save-parts
381 "u" gnus-uu-decode-uu
382 "U" gnus-uu-decode-uu-and-save
383 "s" gnus-uu-decode-unshar
384 "S" gnus-uu-decode-unshar-and-save
385 "o" gnus-uu-decode-save
386 "O" gnus-uu-decode-save
387 "b" gnus-uu-decode-binhex
388 "B" gnus-uu-decode-binhex
389 "p" gnus-uu-decode-postscript
390 "P" gnus-uu-decode-postscript-and-save)
391
392 (gnus-define-keys
393 (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
394 "u" gnus-uu-decode-uu-view
395 "U" gnus-uu-decode-uu-and-save-view
396 "s" gnus-uu-decode-unshar-view
397 "S" gnus-uu-decode-unshar-and-save-view
398 "o" gnus-uu-decode-save-view
399 "O" gnus-uu-decode-save-view
400 "b" gnus-uu-decode-binhex-view
401 "B" gnus-uu-decode-binhex-view
402 "p" gnus-uu-decode-postscript-view
403 "P" gnus-uu-decode-postscript-and-save-view)
404
405 356
406 ;; Commands. 357 ;; Commands.
407 358
408 (defun gnus-uu-decode-uu (&optional n) 359 (defun gnus-uu-decode-uu (&optional n)
409 "Uudecodes the current article." 360 "Uudecodes the current article."
527 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) 478 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
528 gnus-uu-digest-buffer subject from) 479 gnus-uu-digest-buffer subject from)
529 (if (and n (not (numberp n))) 480 (if (and n (not (numberp n)))
530 (setq message-forward-as-mime (not message-forward-as-mime) 481 (setq message-forward-as-mime (not message-forward-as-mime)
531 n nil)) 482 n nil))
532 (gnus-setup-message 'forward 483 (let ((gnus-article-reply (gnus-summary-work-articles n)))
533 (setq gnus-uu-digest-from-subject nil) 484 (gnus-setup-message 'forward
534 (setq gnus-uu-digest-buffer 485 (setq gnus-uu-digest-from-subject nil)
535 (gnus-get-buffer-create " *gnus-uu-forward*")) 486 (setq gnus-uu-digest-buffer
536 (gnus-uu-decode-save n file) 487 (gnus-get-buffer-create " *gnus-uu-forward*"))
537 (switch-to-buffer gnus-uu-digest-buffer) 488 (gnus-uu-decode-save n file)
538 (let ((fs gnus-uu-digest-from-subject)) 489 (switch-to-buffer gnus-uu-digest-buffer)
539 (when fs 490 (let ((fs gnus-uu-digest-from-subject))
540 (setq from (caar fs) 491 (when fs
541 subject (gnus-simplify-subject-fuzzy (cdar fs)) 492 (setq from (caar fs)
542 fs (cdr fs)) 493 subject (gnus-simplify-subject-fuzzy (cdar fs))
543 (while (and fs (or from subject)) 494 fs (cdr fs))
544 (when from 495 (while (and fs (or from subject))
545 (unless (string= from (caar fs)) 496 (when from
546 (setq from nil))) 497 (unless (string= from (caar fs))
547 (when subject 498 (setq from nil)))
548 (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) 499 (when subject
549 subject) 500 (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
550 (setq subject nil))) 501 subject)
551 (setq fs (cdr fs)))) 502 (setq subject nil)))
552 (unless subject 503 (setq fs (cdr fs))))
553 (setq subject "Digested Articles")) 504 (unless subject
554 (unless from 505 (setq subject "Digested Articles"))
555 (setq from 506 (unless from
556 (if (gnus-news-group-p gnus-newsgroup-name) 507 (setq from
557 gnus-newsgroup-name 508 (if (gnus-news-group-p gnus-newsgroup-name)
558 "Various")))) 509 gnus-newsgroup-name
559 (goto-char (point-min)) 510 "Various"))))
560 (when (re-search-forward "^Subject: ") 511 (goto-char (point-min))
561 (delete-region (point) (gnus-point-at-eol)) 512 (when (re-search-forward "^Subject: ")
562 (insert subject)) 513 (delete-region (point) (gnus-point-at-eol))
563 (goto-char (point-min)) 514 (insert subject))
564 (when (re-search-forward "^From:") 515 (goto-char (point-min))
565 (delete-region (point) (gnus-point-at-eol)) 516 (when (re-search-forward "^From:")
566 (insert " " from)) 517 (delete-region (point) (gnus-point-at-eol))
567 (let ((message-forward-decoded-p t)) 518 (insert " " from))
568 (message-forward post t))) 519 (let ((message-forward-decoded-p t))
520 (message-forward post t))))
569 (setq gnus-uu-digest-from-subject nil))) 521 (setq gnus-uu-digest-from-subject nil)))
570 522
571 (defun gnus-uu-digest-post-forward (&optional n) 523 (defun gnus-uu-digest-post-forward (&optional n)
572 "Digest and forward to a newsgroup." 524 "Digest and forward to a newsgroup."
573 (interactive "P") 525 (interactive "P")
574 (gnus-uu-digest-mail-forward n t)) 526 (gnus-uu-digest-mail-forward n t))
575 527
576 ;; Process marking. 528 ;; Process marking.
529
530 (defun gnus-message-process-mark (unmarkp new-marked)
531 (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
532 (message "%d mark%s %s%s"
533 (length new-marked)
534 (if (= (length new-marked) 1) "" "s")
535 (if unmarkp "removed" "added")
536 (cond
537 ((and (zerop old)
538 (not unmarkp))
539 "")
540 (unmarkp
541 (format ", %d remain marked"
542 (length gnus-newsgroup-processable)))
543 (t
544 (format ", %d already marked" old))))))
545
546 (defun gnus-new-processable (unmarkp articles)
547 (if unmarkp
548 (gnus-intersection gnus-newsgroup-processable articles)
549 (gnus-set-difference articles gnus-newsgroup-processable)))
577 550
578 (defun gnus-uu-mark-by-regexp (regexp &optional unmark) 551 (defun gnus-uu-mark-by-regexp (regexp &optional unmark)
579 "Set the process mark on articles whose subjects match REGEXP. 552 "Set the process mark on articles whose subjects match REGEXP.
580 When called interactively, prompt for REGEXP. 553 When called interactively, prompt for REGEXP.
581 Optional UNMARK non-nil means unmark instead of mark." 554 Optional UNMARK non-nil means unmark instead of mark."
582 (interactive "sMark (regexp): \nP") 555 (interactive "sMark (regexp): \nP")
583 (let ((articles (gnus-uu-find-articles-matching regexp))) 556 (save-excursion
584 (while articles 557 (let* ((articles (gnus-uu-find-articles-matching regexp))
585 (if unmark 558 (new-marked (gnus-new-processable unmark articles)))
586 (gnus-summary-remove-process-mark (pop articles)) 559 (while articles
587 (gnus-summary-set-process-mark (pop articles)))) 560 (if unmark
588 (message "")) 561 (gnus-summary-remove-process-mark (pop articles))
562 (gnus-summary-set-process-mark (pop articles))))
563 (gnus-message-process-mark unmark new-marked)))
589 (gnus-summary-position-point)) 564 (gnus-summary-position-point))
590 565
591 (defun gnus-uu-unmark-by-regexp (regexp) 566 (defun gnus-uu-unmark-by-regexp (regexp)
592 "Remove the process mark from articles whose subjects match REGEXP. 567 "Remove the process mark from articles whose subjects match REGEXP.
593 When called interactively, prompt for REGEXP." 568 When called interactively, prompt for REGEXP."
595 (gnus-uu-mark-by-regexp regexp t)) 570 (gnus-uu-mark-by-regexp regexp t))
596 571
597 (defun gnus-uu-mark-series () 572 (defun gnus-uu-mark-series ()
598 "Mark the current series with the process mark." 573 "Mark the current series with the process mark."
599 (interactive) 574 (interactive)
600 (let ((articles (gnus-uu-find-articles-matching))) 575 (let* ((articles (gnus-uu-find-articles-matching))
576 (l (length articles)))
601 (while articles 577 (while articles
602 (gnus-summary-set-process-mark (car articles)) 578 (gnus-summary-set-process-mark (car articles))
603 (setq articles (cdr articles))) 579 (setq articles (cdr articles)))
604 (message "")) 580 (message "Marked %d articles" l))
605 (gnus-summary-position-point)) 581 (gnus-summary-position-point))
606 582
607 (defun gnus-uu-mark-region (beg end &optional unmark) 583 (defun gnus-uu-mark-region (beg end &optional unmark)
608 "Set the process mark on all articles between point and mark." 584 "Set the process mark on all articles between point and mark."
609 (interactive "r") 585 (interactive "r")
860 (erase-buffer) 836 (erase-buffer)
861 (insert (format 837 (insert (format
862 "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" 838 "Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
863 (current-time-string) name name)) 839 (current-time-string) name name))
864 (when (and message-forward-as-mime gnus-uu-digest-buffer) 840 (when (and message-forward-as-mime gnus-uu-digest-buffer)
865 ;; The default part in multipart/digest is message/rfc822. 841 (insert "<#part type=message/rfc822>\nSubject: Topics\n\n"))
866 ;; Subject is a fake head.
867 (insert "<#part type=text/plain>\nSubject: Topics\n\n"))
868 (insert "Topics:\n"))) 842 (insert "Topics:\n")))
869 (when (not (eq in-state 'end)) 843 (when (not (eq in-state 'end))
870 (setq state (list 'middle)))) 844 (setq state (list 'middle))))
871 (save-excursion 845 (save-excursion
872 (set-buffer "*gnus-uu-body*") 846 (set-buffer "*gnus-uu-body*")
894 (delete-char 1) 868 (delete-char 1)
895 (insert "- ")))) 869 (insert "- "))))
896 (setq body (buffer-substring (1- (point)) (point-max))) 870 (setq body (buffer-substring (1- (point)) (point-max)))
897 (narrow-to-region (point-min) (point)) 871 (narrow-to-region (point-min) (point))
898 (if (not (setq headers gnus-uu-digest-headers)) 872 (if (not (setq headers gnus-uu-digest-headers))
899 (setq sorthead (buffer-substring (point-min) (point-max))) 873 (setq sorthead (buffer-string))
900 (while headers 874 (while headers
901 (setq headline (car headers)) 875 (setq headline (car headers))
902 (setq headers (cdr headers)) 876 (setq headers (cdr headers))
903 (goto-char (point-min)) 877 (goto-char (point-min))
904 (while (re-search-forward headline nil t) 878 (while (re-search-forward headline nil t)
1114 1088
1115 (goto-char 1) 1089 (goto-char 1)
1116 (while (re-search-forward "[ \t]+" nil t) 1090 (while (re-search-forward "[ \t]+" nil t)
1117 (replace-match "[ \t]+" t t)) 1091 (replace-match "[ \t]+" t t))
1118 1092
1119 (buffer-substring (point-min) (point-max)))) 1093 (buffer-string)))
1120 1094
1121 (defun gnus-uu-get-list-of-articles (n) 1095 (defun gnus-uu-get-list-of-articles (n)
1122 ;; If N is non-nil, the article numbers of the N next articles 1096 ;; If N is non-nil, the article numbers of the N next articles
1123 ;; will be returned. 1097 ;; will be returned.
1124 ;; If any articles have been marked as processable, they will be 1098 ;; If any articles have been marked as processable, they will be
1206 (while (re-search-forward "[A-Za-z]" nil t) 1180 (while (re-search-forward "[A-Za-z]" nil t)
1207 (replace-match "a" t t))) 1181 (replace-match "a" t t)))
1208 ;; Expand numbers. 1182 ;; Expand numbers.
1209 (goto-char (point-min)) 1183 (goto-char (point-min))
1210 (while (re-search-forward "[0-9]+" nil t) 1184 (while (re-search-forward "[0-9]+" nil t)
1211 (replace-match 1185 (ignore-errors
1212 (format "%06d" 1186 (replace-match
1213 (string-to-int (buffer-substring 1187 (format "%06d"
1214 (match-beginning 0) (match-end 0)))))) 1188 (string-to-int (buffer-substring
1215 (setq string (buffer-substring (point-min) (point-max))) 1189 (match-beginning 0) (match-end 0)))))))
1190 (setq string (buffer-substring 1 (point-max)))
1216 (setcar (car string-list) string) 1191 (setcar (car string-list) string)
1217 (setq string-list (cdr string-list)))) 1192 (setq string-list (cdr string-list))))
1218 out-list)) 1193 out-list))
1219 1194
1220 1195
1375 (memq 'middle process-state))) 1350 (memq 'middle process-state)))
1376 (progn 1351 (progn
1377 (setq process-state (list 'error)) 1352 (setq process-state (list 'error))
1378 (gnus-message 2 "No begin part at the beginning") 1353 (gnus-message 2 "No begin part at the beginning")
1379 (sleep-for 2)) 1354 (sleep-for 2))
1380 (setq state 'middle))) 1355 (setq state 'middle))))
1381 1356
1382 ;; When there are no result-files, then something must be wrong. 1357 ;; When there are no result-files, then something must be wrong.
1383 (if result-files 1358 (if result-files
1384 (message "") 1359 (message "")
1385 (cond 1360 (cond
1386 ((not has-been-begin) 1361 ((not has-been-begin)
1387 (gnus-message 2 "Wrong type file")) 1362 (gnus-message 2 "Wrong type file"))
1388 ((memq 'error process-state) 1363 ((memq 'error process-state)
1389 (gnus-message 2 "An error occurred during decoding")) 1364 (gnus-message 2 "An error occurred during decoding"))
1390 ((not (or (memq 'ok process-state) 1365 ((not (or (memq 'ok process-state)
1391 (memq 'end process-state))) 1366 (memq 'end process-state)))
1392 (gnus-message 2 "End of articles reached before end of file"))) 1367 (gnus-message 2 "End of articles reached before end of file")))
1393 ;; Make unsuccessfully decoded articles unread. 1368 ;; Make unsuccessfully decoded articles unread.
1394 (when gnus-uu-unmark-articles-not-decoded 1369 (when gnus-uu-unmark-articles-not-decoded
1395 (while article-series 1370 (while article-series
1396 (gnus-summary-tick-article (pop article-series) t))))) 1371 (gnus-summary-tick-article (pop article-series) t))))
1397 1372
1398 ;; The original article buffer is hosed, shoot it down. 1373 ;; The original article buffer is hosed, shoot it down.
1399 (gnus-kill-buffer gnus-original-article-buffer) 1374 (gnus-kill-buffer gnus-original-article-buffer)
1400 1375 (setq gnus-current-article nil)
1401 result-files)) 1376 result-files))
1402 1377
1403 (defun gnus-uu-grab-view (file) 1378 (defun gnus-uu-grab-view (file)
1404 "View FILE using the gnus-uu methods." 1379 "View FILE using the gnus-uu methods."
1405 (let ((action (gnus-uu-get-action file))) 1380 (let ((action (gnus-uu-get-action file)))
1461 (if (not (looking-at gnus-uu-begin-string)) 1436 (if (not (looking-at gnus-uu-begin-string))
1462 (setq state (list 'middle)) 1437 (setq state (list 'middle))
1463 ;; This is the beginning of a uuencoded article. 1438 ;; This is the beginning of a uuencoded article.
1464 ;; We replace certain characters that could make things messy. 1439 ;; We replace certain characters that could make things messy.
1465 (setq gnus-uu-file-name 1440 (setq gnus-uu-file-name
1466 (let ((nnheader-file-name-translation-alist 1441 (gnus-map-function
1467 '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) 1442 mm-file-name-rewrite-functions
1468 (nnheader-translate-file-chars (match-string 1)))) 1443 (file-name-nondirectory (match-string 1))))
1469 (replace-match (concat "begin 644 " gnus-uu-file-name) t t) 1444 (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
1470 1445
1471 ;; Remove any non gnus-uu-body-line right after start. 1446 ;; Remove any non gnus-uu-body-line right after start.
1472 (forward-line 1) 1447 (forward-line 1)
1473 (while (and (not (eobp)) 1448 (while (and (not (eobp))
1474 (not (looking-at gnus-uu-body-line))) 1449 (not (looking-at gnus-uu-body-line)))
1653 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) 1628 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
1654 (erase-buffer)) 1629 (erase-buffer))
1655 1630
1656 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) 1631 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
1657 1632
1658 (if (= 0 (call-process shell-file-name nil 1633 (if (eq 0 (call-process shell-file-name nil
1659 (gnus-get-buffer-create gnus-uu-output-buffer-name) 1634 (gnus-get-buffer-create gnus-uu-output-buffer-name)
1660 nil shell-command-switch command)) 1635 nil shell-command-switch command))
1661 (message "") 1636 (message "")
1662 (gnus-message 2 "Error during unpacking of archive") 1637 (gnus-message 2 "Error during unpacking of archive")
1663 (setq did-unpack nil)) 1638 (setq did-unpack nil))
1818 (while (setq file (pop files)) 1793 (while (setq file (pop files))
1819 (unless (member (file-name-nondirectory file) '("." "..")) 1794 (unless (member (file-name-nondirectory file) '("." ".."))
1820 (if (file-directory-p file) 1795 (if (file-directory-p file)
1821 (gnus-uu-delete-work-dir file) 1796 (gnus-uu-delete-work-dir file)
1822 (gnus-message 9 "Deleting file %s..." file) 1797 (gnus-message 9 "Deleting file %s..." file)
1823 (delete-file file)))) 1798 (condition-case err
1824 (delete-directory dir))) 1799 (delete-file file)
1825 (gnus-message 7 "")) 1800 (error (gnus-message 3 "Deleting file %s failed... %s" file err))))))
1801 (condition-case err
1802 (delete-directory dir)
1803 (error (gnus-message 3 "Deleting directory %s failed... %s" file err))))
1804 (gnus-message 7 "")))
1826 1805
1827 ;; Initializing 1806 ;; Initializing
1828 1807
1829 (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) 1808 (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
1830 (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) 1809 (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
1898 (gnus-summary-post-news) 1877 (gnus-summary-post-news)
1899 1878
1900 (let ((map (make-sparse-keymap))) 1879 (let ((map (make-sparse-keymap)))
1901 (set-keymap-parent map (current-local-map)) 1880 (set-keymap-parent map (current-local-map))
1902 (use-local-map map)) 1881 (use-local-map map))
1903 (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) 1882 ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
1904 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) 1883 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
1905 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) 1884 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
1906 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) 1885 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
1907 1886
1908 (when gnus-uu-post-include-before-composing 1887 (when gnus-uu-post-include-before-composing
1931 (gnus-uu-post-make-mime file-name "x-uue") 1910 (gnus-uu-post-make-mime file-name "x-uue")
1932 t)) 1911 t))
1933 1912
1934 ;; Encodes with base64 and adds MIME headers 1913 ;; Encodes with base64 and adds MIME headers
1935 (defun gnus-uu-post-encode-mime (path file-name) 1914 (defun gnus-uu-post-encode-mime (path file-name)
1936 (when (zerop (call-process shell-file-name nil t nil shell-command-switch 1915 (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch
1937 (format "%s %s -o %s" "mmencode" path file-name))) 1916 (format "%s %s -o %s" "mmencode" path file-name)))
1938 (gnus-uu-post-make-mime file-name "base64") 1917 (gnus-uu-post-make-mime file-name "base64")
1939 t)) 1918 t))
1940 1919
1941 ;; Adds MIME headers. 1920 ;; Adds MIME headers.
1942 (defun gnus-uu-post-make-mime (file-name encoding) 1921 (defun gnus-uu-post-make-mime (file-name encoding)
1957 (widen))) 1936 (widen)))
1958 1937
1959 ;; Encodes a file PATH with COMMAND, leaving the result in the 1938 ;; Encodes a file PATH with COMMAND, leaving the result in the
1960 ;; current buffer. 1939 ;; current buffer.
1961 (defun gnus-uu-post-encode-file (command path file-name) 1940 (defun gnus-uu-post-encode-file (command path file-name)
1962 (= 0 (call-process shell-file-name nil t nil shell-command-switch 1941 (eq 0 (call-process shell-file-name nil t nil shell-command-switch
1963 (format "%s %s %s" command path file-name)))) 1942 (format "%s %s %s" command path file-name))))
1964 1943
1965 (defun gnus-uu-post-news-inews () 1944 (defun gnus-uu-post-news-inews ()
1966 "Posts the composed news article and encoded file. 1945 "Posts the composed news article and encoded file.
1967 If no file has been included, the user will be asked for a file." 1946 If no file has been included, the user will be asked for a file."
1968 (interactive) 1947 (interactive)