Lines Matching +refs:gnus +refs:header +refs:name
0 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
33 (require 'gnus)
34 (require 'gnus-art)
36 (require 'gnus-msg)
39 (defgroup gnus-extract nil
41 :prefix "gnus-uu-"
42 :group 'gnus)
44 (defgroup gnus-extract-view nil
46 :group 'gnus-extract)
48 (defgroup gnus-extract-archive nil
50 :group 'gnus-extract)
52 (defgroup gnus-extract-post nil
54 :prefix "gnus-uu-post"
55 :group 'gnus-extract)
59 (defcustom gnus-uu-default-view-rules
76 "gnus-uu-archive"))
79 `gnus-uu-user-view-rules' to something useful.
83 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
86 (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
89 first string is a regular expression. If the file name matches this
93 If the command string contains \"%s\", the file name will be inserted
95 command string, the file name will be appended to the command string
98 There are several user variables to tailor the behaviour of gnus-uu to
99 your needs. First we have `gnus-uu-user-view-rules', which is the
100 variable gnus-uu first consults when trying to decide how to view a
101 file. If this variable contains no matches, gnus-uu examines the
102 default rule variable provided in this package. If gnus-uu finds no
103 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
105 :group 'gnus-extract-view
108 (defcustom gnus-uu-user-view-rules nil
110 See the documentation on the `gnus-uu-default-view-rules' variable for
112 :group 'gnus-extract-view
115 (defcustom gnus-uu-user-view-rules-end
117 "*What actions are to be taken if no rule matched the file name.
118 See the documentation on the `gnus-uu-default-view-rules' variable for
120 :group 'gnus-extract-view
125 (defcustom gnus-uu-default-archive-rules
135 "*See `gnus-uu-user-archive-rules'."
136 :group 'gnus-extract-archive
139 (defvar gnus-uu-destructive-archivers
142 (defcustom gnus-uu-user-archive-rules nil
146 (setq gnus-uu-user-archive-rules
149 :group 'gnus-extract-archive
152 (defcustom gnus-uu-ignore-files-by-name nil
153 "*A regular expression saying what files should not be viewed based on name.
154 If, for instance, you want gnus-uu to ignore all .au and .wav files,
157 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
160 `gnus-uu-ignore-files-by-type' variable."
161 :group 'gnus-extract
165 (defcustom gnus-uu-ignore-files-by-type nil
167 If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
170 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
173 `gnus-uu-ignore-files-by-name' variable."
174 :group 'gnus-extract
180 (defconst gnus-uu-ext-to-mime-list
221 (defcustom gnus-uu-tmp-dir
225 "*Variable saying where gnus-uu is to do its work.
227 :group 'gnus-extract
230 (defcustom gnus-uu-do-not-unpack-archives nil
231 "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
233 :group 'gnus-extract-archive
236 (defcustom gnus-uu-ignore-default-view-rules nil
237 "*Non-nil means that gnus-uu will ignore the default viewing rules.
239 :group 'gnus-extract-view
242 (defcustom gnus-uu-grabbed-file-functions nil
244 They will be called with the name of the file as the argument.
245 Likely functions you can use in this list are `gnus-uu-grab-view'
246 and `gnus-uu-grab-move'."
247 :group 'gnus-extract
248 :options '(gnus-uu-grab-view gnus-uu-grab-move)
251 (defcustom gnus-uu-ignore-default-archive-rules nil
252 "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
254 :group 'gnus-extract-archive
257 (defcustom gnus-uu-kill-carriage-return t
258 "*Non-nil means that gnus-uu will strip all carriage returns from articles.
260 :group 'gnus-extract
263 (defcustom gnus-uu-view-with-metamail nil
265 The gnus-uu viewing functions will be ignored and gnus-uu will try
266 to guess at a content-type based on file name suffixes. Default
268 :group 'gnus-extract
271 (defcustom gnus-uu-unmark-articles-not-decoded nil
272 "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
274 :group 'gnus-extract
277 (defcustom gnus-uu-correct-stripped-uucode nil
278 "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
280 :group 'gnus-extract
283 (defcustom gnus-uu-save-in-digest nil
284 "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
285 If this variable is nil, gnus-uu will just save everything in a
289 :group 'gnus-extract
292 (defcustom gnus-uu-pre-uudecode-hook nil
294 :group 'gnus-extract
297 (defcustom gnus-uu-digest-headers
305 :group 'gnus-extract
308 (defcustom gnus-uu-save-separate-articles nil
309 "*Non-nil means that gnus-uu will save articles in separate files."
310 :group 'gnus-extract
313 (defcustom gnus-uu-be-dangerous 'ask
317 :group 'gnus-extract
324 (defvar gnus-uu-saved-article-name nil)
326 (defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
327 (defvar gnus-uu-end-string "^end[ \t]*$")
329 (defvar gnus-uu-body-line "^M")
332 (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
333 (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
337 (defvar gnus-uu-shar-begin-string "^#! */bin/sh")
339 (defvar gnus-uu-shar-file-name nil)
340 (defvar gnus-uu-shar-name-marker
343 (defvar gnus-uu-postscript-begin-string "^%!PS-")
344 (defvar gnus-uu-postscript-end-string "^%%EOF$")
346 (defvar gnus-uu-file-name nil)
347 (defvar gnus-uu-uudecode-process nil)
348 (defvar gnus-uu-binhex-article-name nil)
350 (defvar gnus-uu-work-dir nil)
352 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
354 (defvar gnus-uu-default-dir gnus-article-save-directory)
355 (defvar gnus-uu-digest-from-subject nil)
356 (defvar gnus-uu-digest-buffer nil)
360 (defun gnus-uu-decode-uu (&optional n)
363 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
365 (defun gnus-uu-decode-uu-and-save (n dir)
369 (file-name-as-directory
370 (read-file-name "Uudecode and save in dir: "
371 gnus-uu-default-dir
372 gnus-uu-default-dir t))))
373 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
375 (defun gnus-uu-decode-unshar (&optional n)
378 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
380 (defun gnus-uu-decode-unshar-and-save (n dir)
384 (file-name-as-directory
385 (read-file-name "Unshar and save in dir: "
386 gnus-uu-default-dir
387 gnus-uu-default-dir t))))
388 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
390 (defun gnus-uu-decode-save (n file)
394 (read-file-name
395 (if gnus-uu-save-separate-articles
398 gnus-uu-default-dir
399 gnus-uu-default-dir)))
400 (setq gnus-uu-saved-article-name file)
401 (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
403 (defun gnus-uu-decode-binhex (n dir)
407 (file-name-as-directory
408 (read-file-name "Unbinhex and save in dir: "
409 gnus-uu-default-dir
410 gnus-uu-default-dir))))
411 (setq gnus-uu-binhex-article-name
412 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
413 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
415 (defun gnus-uu-decode-uu-view (&optional n)
418 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
419 (gnus-uu-decode-uu n)))
421 (defun gnus-uu-decode-uu-and-save-view (n dir)
425 (read-file-name "Uudecode, view and save in dir: "
426 gnus-uu-default-dir
427 gnus-uu-default-dir t)))
428 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
429 (gnus-uu-decode-uu-and-save n dir)))
431 (defun gnus-uu-decode-unshar-view (&optional n)
434 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
435 (gnus-uu-decode-unshar n)))
437 (defun gnus-uu-decode-unshar-and-save-view (n dir)
441 (read-file-name "Unshar, view and save in dir: "
442 gnus-uu-default-dir
443 gnus-uu-default-dir t)))
444 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
445 (gnus-uu-decode-unshar-and-save n dir)))
447 (defun gnus-uu-decode-save-view (n file)
451 (read-file-name (if gnus-uu-save-separate-articles
454 gnus-uu-default-dir gnus-uu-default-dir)))
455 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
456 (gnus-uu-decode-save n file)))
458 (defun gnus-uu-decode-binhex-view (n file)
462 (read-file-name "Unbinhex, view and save in dir: "
463 gnus-uu-default-dir gnus-uu-default-dir)))
464 (setq gnus-uu-binhex-article-name
465 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
466 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
467 (gnus-uu-decode-binhex n file)))
472 (defun gnus-uu-digest-mail-forward (&optional n post)
475 (let ((gnus-uu-save-in-digest t)
476 (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
478 (mail-parse-charset gnus-newsgroup-charset)
479 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
480 gnus-uu-digest-buffer subject from)
484 (let ((gnus-article-reply (gnus-summary-work-articles n)))
485 (gnus-setup-message 'forward
486 (setq gnus-uu-digest-from-subject nil)
487 (setq gnus-uu-digest-buffer
488 (gnus-get-buffer-create " *gnus-uu-forward*"))
489 (gnus-uu-decode-save n file)
490 (switch-to-buffer gnus-uu-digest-buffer)
491 (let ((fs gnus-uu-digest-from-subject))
494 subject (gnus-simplify-subject-fuzzy (cdar fs))
501 (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
509 (if (gnus-news-group-p gnus-newsgroup-name)
510 gnus-newsgroup-name
514 (delete-region (point) (gnus-point-at-eol))
518 (delete-region (point) (gnus-point-at-eol))
522 (setq gnus-uu-digest-from-subject nil)))
524 (defun gnus-uu-digest-post-forward (&optional n)
527 (gnus-uu-digest-mail-forward n t))
531 (defun gnus-message-process-mark (unmarkp new-marked)
532 (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
543 (length gnus-newsgroup-processable)))
547 (defun gnus-new-processable (unmarkp articles)
549 (gnus-intersection gnus-newsgroup-processable articles)
550 (gnus-set-difference articles gnus-newsgroup-processable)))
552 (defun gnus-uu-mark-by-regexp (regexp &optional unmark)
558 (let* ((articles (gnus-uu-find-articles-matching regexp))
559 (new-marked (gnus-new-processable unmark articles)))
562 (gnus-summary-remove-process-mark (pop articles))
563 (gnus-summary-set-process-mark (pop articles))))
564 (gnus-message-process-mark unmark new-marked)))
565 (gnus-summary-position-point))
567 (defun gnus-uu-unmark-by-regexp (regexp)
571 (gnus-uu-mark-by-regexp regexp t))
573 (defun gnus-uu-mark-series ()
576 (let* ((articles (gnus-uu-find-articles-matching))
579 (gnus-summary-set-process-mark (car articles))
582 (gnus-summary-position-point))
584 (defun gnus-uu-mark-region (beg end &optional unmark)
591 (gnus-summary-remove-process-mark (gnus-summary-article-number))
592 (gnus-summary-set-process-mark (gnus-summary-article-number)))
594 (gnus-summary-position-point))
596 (defun gnus-uu-unmark-region (beg end)
599 (gnus-uu-mark-region beg end t))
601 (defun gnus-uu-mark-buffer ()
604 (gnus-uu-mark-region (point-min) (point-max)))
606 (defun gnus-uu-unmark-buffer ()
609 (gnus-uu-mark-region (point-min) (point-max) t))
611 (defun gnus-uu-mark-thread ()
614 (gnus-save-hidden-threads
615 (let ((level (gnus-summary-thread-level)))
616 (while (and (gnus-summary-set-process-mark
617 (gnus-summary-article-number))
618 (zerop (gnus-summary-next-subject 1 nil t))
619 (> (gnus-summary-thread-level) level)))))
620 (gnus-summary-position-point))
622 (defun gnus-uu-unmark-thread ()
625 (let ((level (gnus-summary-thread-level)))
626 (while (and (gnus-summary-remove-process-mark
627 (gnus-summary-article-number))
628 (zerop (gnus-summary-next-subject 1))
629 (> (gnus-summary-thread-level) level))))
630 (gnus-summary-position-point))
632 (defun gnus-uu-invert-processable ()
635 (let ((data gnus-newsgroup-data)
639 (if (memq (setq number (gnus-data-number (pop data)))
640 gnus-newsgroup-processable)
641 (gnus-summary-remove-process-mark number)
642 (gnus-summary-set-process-mark number)))))
643 (gnus-summary-position-point))
645 (defun gnus-uu-mark-over (&optional score)
648 (let ((score (or score gnus-summary-default-score 0))
649 (data gnus-newsgroup-data))
652 (when (> (or (cdr (assq (gnus-data-number (car data))
653 gnus-newsgroup-scored))
654 gnus-summary-default-score 0)
656 (gnus-summary-set-process-mark (caar data)))
658 (gnus-summary-position-point)))
660 (defun gnus-uu-mark-sparse ()
663 (let ((marked (nreverse gnus-newsgroup-processable))
667 (setq gnus-newsgroup-processable nil)
671 (gnus-summary-article-header (car marked))))
672 (setq subject (mail-header-subject headers)
673 articles (gnus-uu-find-articles-matching
674 (gnus-uu-reginize-string subject))
677 (gnus-summary-set-process-mark (car articles))
681 (setq gnus-newsgroup-processable (nreverse total)))
682 (gnus-summary-position-point)))
684 (defun gnus-uu-mark-all ()
687 (setq gnus-newsgroup-processable nil)
689 (let ((data gnus-newsgroup-data)
692 (when (and (not (memq (setq number (gnus-data-number (car data)))
693 gnus-newsgroup-processable))
694 (vectorp (gnus-data-header (car data))))
695 (gnus-summary-goto-subject number)
696 (gnus-uu-mark-series))
698 (gnus-summary-position-point))
702 (defun gnus-uu-decode-postscript (&optional n)
705 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
707 (defun gnus-uu-decode-postscript-view (&optional n)
710 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
711 (gnus-uu-decode-postscript n)))
713 (defun gnus-uu-decode-postscript-and-save (n dir)
717 (file-name-as-directory
718 (read-file-name "Save in dir: "
719 gnus-uu-default-dir
720 gnus-uu-default-dir t))))
721 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
724 (defun gnus-uu-decode-postscript-and-save-view (n dir)
728 (read-file-name "Where do you want to save the file(s)? "
729 gnus-uu-default-dir
730 gnus-uu-default-dir t)))
731 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
732 (gnus-uu-decode-postscript-and-save n dir)))
737 (defun gnus-uu-decode-with-method (method n &optional save not-insert
739 (gnus-uu-initialize scan)
741 (setq gnus-uu-default-dir save))
746 (let ((articles (gnus-uu-get-list-of-articles n))
748 (setq files (gnus-uu-grab-articles articles method t))
749 (let ((gnus-current-article (car articles)))
751 (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
753 (gnus-uu-save-files files save))
754 (when (eq gnus-uu-do-not-unpack-archives nil)
755 (setq files (gnus-uu-unpack-files files)))
756 (setq files (nreverse (gnus-uu-get-actions files)))
757 (or not-insert (not gnus-insert-pseudo-articles)
758 (gnus-summary-insert-pseudos files save))))
760 (defun gnus-uu-scan-directory (dir &optional rec)
765 (unless (member (file-name-nondirectory file) '("." ".."))
766 (push (list (cons 'name file)
767 (cons 'article gnus-current-article))
770 (setq out (nconc (gnus-uu-scan-directory file t) out)))))
775 (defun gnus-uu-save-files (files dir)
778 (reg (concat "^" (regexp-quote gnus-uu-work-dir)))
780 (while (setq file (cdr (assq 'name (pop files))))
785 (gnus-make-directory (concat dir fromdir))
788 (eq gnus-uu-be-dangerous t)
789 (and gnus-uu-be-dangerous
790 (gnus-y-or-n-p (format "%s exists; overwrite? "
793 (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
798 ;; Function called by gnus-uu-grab-articles to treat each article.
799 (defun gnus-uu-save-article (buffer in-state)
801 (gnus-uu-save-separate-articles
805 (gnus-write-buffer
806 (concat gnus-uu-saved-article-name gnus-current-article)))
807 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
808 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
812 ((not gnus-uu-save-in-digest)
815 (write-region (point-min) (point-max) gnus-uu-saved-article-name t)
816 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
817 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
822 (let ((header (gnus-summary-article-header)))
823 (push (cons (mail-header-from header)
824 (mail-header-subject header))
825 gnus-uu-digest-from-subject))
826 (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
833 (set-buffer (gnus-get-buffer-create "*gnus-uu-body*"))
836 (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*"))
840 (message-make-date) name name))
841 (when (and message-forward-as-mime gnus-uu-digest-buffer)
849 (set-buffer "*gnus-uu-body*")
855 (gnus-set-text-properties (point-min) (point-max) nil)
861 gnus-uu-digest-buffer)
866 (unless (and message-forward-as-mime gnus-uu-digest-buffer)
875 (if (not (setq headers gnus-uu-digest-headers))
890 (if (and message-forward-as-mime gnus-uu-digest-buffer)
907 " buffer=\"" (buffer-name buf) "\">\n")))
916 (set-buffer "*gnus-uu-pre*")
920 (if (and message-forward-as-mime gnus-uu-digest-buffer)
921 (with-current-buffer gnus-uu-digest-buffer
923 (insert-buffer-substring "*gnus-uu-pre*")
925 (insert-buffer-substring "*gnus-uu-body*"))
927 (set-buffer "*gnus-uu-pre*")
929 (if gnus-uu-digest-buffer
930 (with-current-buffer gnus-uu-digest-buffer
932 (insert-buffer-substring "*gnus-uu-pre*"))
934 (gnus-write-buffer gnus-uu-saved-article-name))))
936 (set-buffer "*gnus-uu-body*")
939 (concat (setq end-string (format "End of %s Digest" name))
942 (if gnus-uu-digest-buffer
943 (with-current-buffer gnus-uu-digest-buffer
945 (insert-buffer-substring "*gnus-uu-body*"))
947 (file-name-coding-system nnmail-pathname-coding-system))
949 (point-min) (point-max) gnus-uu-saved-article-name t)))))
950 (gnus-kill-buffer "*gnus-uu-pre*")
951 (gnus-kill-buffer "*gnus-uu-body*")
954 (cons gnus-uu-saved-article-name state)
959 (defvar gnus-uu-binhex-body-line
961 (defvar gnus-uu-binhex-begin-line
963 (defvar gnus-uu-binhex-end-line
966 (defun gnus-uu-binhex-article (buffer in-state)
972 (when (not (re-search-forward gnus-uu-binhex-begin-line nil t))
973 (when (not (re-search-forward gnus-uu-binhex-body-line nil t))
980 (if (looking-at gnus-uu-binhex-begin-line)
984 gnus-uu-binhex-article-name))
987 (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
988 gnus-uu-binhex-end-line)
990 (when (looking-at gnus-uu-binhex-end-line)
996 (when (file-exists-p gnus-uu-binhex-article-name)
997 (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
999 (cons gnus-uu-binhex-article-name state)
1004 (defun gnus-uu-decode-postscript-article (process-buffer in-state)
1006 start-char end-char file-name)
1010 (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
1014 (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
1017 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
1019 (setq file-name (concat gnus-uu-work-dir
1020 (cdr gnus-article-current) ".ps"))
1021 (write-region (point-min) (point-max) file-name)
1022 (setq state (list file-name 'begin 'end)))))
1028 (defun gnus-uu-get-actions (files)
1030 action name)
1032 (setq name (cdr (assq 'name (car files))))
1034 (setq action (gnus-uu-get-action name))
1035 (setcar files (nconc (list (if (string= action "gnus-uu-archive")
1038 (cons 'execute (gnus-uu-command
1039 action name)))
1044 (defun gnus-uu-get-action (file-name)
1047 (gnus-uu-choose-action
1048 file-name
1050 gnus-uu-user-view-rules
1051 (if gnus-uu-ignore-default-view-rules
1053 gnus-uu-default-view-rules)
1054 gnus-uu-user-view-rules-end)))
1055 (when (and (not (string= (or action "") "gnus-uu-archive"))
1056 gnus-uu-view-with-metamail)
1058 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
1065 (defun gnus-uu-reginize-string (string)
1071 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
1098 (defun gnus-uu-get-list-of-articles (n)
1113 (push (gnus-summary-article-number)
1115 (gnus-summary-search-forward nil nil backward))
1118 (gnus-newsgroup-processable
1119 (reverse gnus-newsgroup-processable))
1121 (gnus-uu-find-articles-matching)))))
1123 (defun gnus-uu-string< (l1 l2)
1126 (defun gnus-uu-find-articles-matching
1129 ;; nil, the current article name will be used. If ONLY-UNREAD is
1133 (gnus-uu-reginize-string (gnus-summary-article-subject))))
1139 (data gnus-newsgroup-data)
1143 (and (not (gnus-data-pseudo-p d))
1145 (= (setq mark (gnus-data-mark d))
1146 gnus-unread-mark)
1147 (= mark gnus-ticked-mark)
1148 (= mark gnus-dormant-mark))
1149 (setq subj (mail-header-subject (gnus-data-header d)))
1151 (push (cons subj (gnus-data-number d))
1157 (sort (gnus-uu-expand-numbers
1160 'gnus-uu-string<))))))
1162 (defun gnus-uu-expand-numbers (string-list &optional translate)
1171 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
1199 ;; `gnus-uu-grab-articles' is the general multi-article treatment
1216 ;; the list *must* be a string with the file name of the decoded
1223 (defvar gnus-uu-has-been-grabbed nil)
1225 (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
1227 (if (not (and gnus-uu-has-been-grabbed
1228 gnus-uu-unmark-articles-not-decoded))
1231 (setq art (car gnus-uu-has-been-grabbed))
1232 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
1233 (while gnus-uu-has-been-grabbed
1234 (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
1235 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
1237 (setq gnus-uu-has-been-grabbed (list art))))))
1244 (defun gnus-uu-grab-articles (articles process-function
1247 (gnus-asynchronous nil)
1248 (gnus-inhibit-treatment t)
1250 gnus-summary-display-article-function
1251 gnus-article-prepare-hook gnus-display-mime-function
1260 (when (vectorp (gnus-summary-article-header article))
1268 (let ((part (gnus-uu-part-number article)))
1269 (gnus-message 6 "Getting article %d%s..."
1271 (gnus-summary-display-article article)
1275 (set-buffer gnus-original-article-buffer)
1278 (set-buffer gnus-summary-buffer)
1281 gnus-original-article-buffer state)))))
1283 (gnus-summary-remove-process-mark article)
1296 (not gnus-uu-be-dangerous)
1297 (or (eq gnus-uu-be-dangerous t)
1298 (gnus-y-or-n-p
1315 (push (list (cons 'name (pop files))
1319 (when gnus-uu-grabbed-file-functions
1320 (let ((funcs gnus-uu-grabbed-file-functions))
1337 (not gnus-uu-be-dangerous)
1338 (or (eq gnus-uu-be-dangerous t)
1339 (gnus-y-or-n-p
1346 gnus-uu-unmark-articles-not-decoded)
1347 (gnus-summary-tick-article article t))
1356 (gnus-message 2 "No begin part at the beginning")
1365 (gnus-message 2 "Wrong type file"))
1367 (gnus-message 2 "An error occurred during decoding"))
1370 (gnus-message 2 "End of articles reached before end of file")))
1372 (when gnus-uu-unmark-articles-not-decoded
1374 (gnus-summary-tick-article (pop article-series) t))))
1377 (gnus-kill-buffer gnus-original-article-buffer)
1378 (setq gnus-current-article nil)
1381 (defun gnus-uu-grab-view (file)
1382 "View FILE using the gnus-uu methods."
1383 (let ((action (gnus-uu-get-action file)))
1384 (gnus-execute-command
1388 (eq gnus-view-pseudos 'not-confirm))))
1390 (defun gnus-uu-grab-move (file)
1392 (when gnus-uu-default-dir
1393 (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
1394 (file-name-nondirectory file))))
1399 (defun gnus-uu-part-number (article)
1400 (let* ((header (gnus-summary-article-header article))
1401 (subject (and header (mail-header-subject header)))
1414 (defun gnus-uu-uudecode-sentinel (process event)
1417 (defun gnus-uu-uustrip-article (process-buffer in-state)
1427 (when gnus-uu-kill-carriage-return
1432 (while (or (re-search-forward gnus-uu-begin-string nil t)
1433 (re-search-forward gnus-uu-body-line nil t))
1439 (if (not (looking-at gnus-uu-begin-string))
1443 (setq gnus-uu-file-name
1444 (gnus-map-function
1445 mm-file-name-rewrite-functions
1446 (file-name-nondirectory (match-string 1))))
1447 (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
1449 ;; Remove any non gnus-uu-body-line right after start.
1452 (not (looking-at gnus-uu-body-line)))
1453 (gnus-delete-line))
1456 (when (and gnus-uu-uudecode-process
1457 (memq (process-status gnus-uu-uudecode-process)
1459 (delete-process gnus-uu-uudecode-process)
1460 (gnus-uu-unmark-list-of-grabbed t))
1466 (cd gnus-uu-work-dir)
1467 (setq gnus-uu-uudecode-process
1470 (gnus-get-buffer-create gnus-uu-output-buffer-name)
1471 shell-file-name shell-command-switch
1472 (format "cd %s %s uudecode" gnus-uu-work-dir
1473 gnus-shell-command-separator))))
1476 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
1478 (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
1481 (if (re-search-forward gnus-uu-end-string nil t)
1484 (re-search-backward gnus-uu-body-line nil t))
1488 (when gnus-uu-uudecode-process
1489 (when (memq (process-status gnus-uu-uudecode-process) '(run stop))
1491 (when gnus-uu-correct-stripped-uucode
1492 (gnus-uu-check-correct-stripped-uucode start-char (point)))
1493 (gnus-run-hooks 'gnus-uu-pre-uudecode-hook)
1498 gnus-uu-uudecode-process start-char (point))
1501 (delete-process gnus-uu-uudecode-process)
1502 (gnus-message 2 "gnus-uu: Couldn't uudecode")
1509 (process-send-eof gnus-uu-uudecode-process))
1510 (while (memq (process-status gnus-uu-uudecode-process)
1512 (accept-process-output gnus-uu-uudecode-process 1)))
1513 (when (or (not gnus-uu-uudecode-process)
1514 (not (memq (process-status gnus-uu-uudecode-process)
1522 (defvar gnus-uu-unshar-warning
1532 "Text of warning message displayed by `gnus-uu-unshar-article'.
1537 ;; This function is used by `gnus-uu-grab-articles' to treat
1539 (defun gnus-uu-unshar-article (process-buffer in-state)
1545 (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
1551 (let ((buffer (get-buffer-create (generate-new-buffer-name
1557 gnus-uu-unshar-warning))
1567 start-char (point-max) shell-file-name nil
1568 (gnus-get-buffer-create gnus-uu-output-buffer-name) nil
1570 (concat "cd " gnus-uu-work-dir " "
1571 gnus-shell-command-separator " sh")))))
1574 ;; Returns the name of what the shar file is going to unpack.
1575 (defun gnus-uu-find-name-in-shar ()
1579 (when (re-search-forward gnus-uu-shar-name-marker nil t)
1584 ;; `gnus-uu-choose-action' chooses what action to perform given the name
1585 ;; and `gnus-uu-file-action-list'. Returns either nil if no action is
1586 ;; found, or the name of the command to run if such a rule is found.
1587 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
1594 (and gnus-uu-ignore-files-by-name
1595 (string-match gnus-uu-ignore-files-by-name file-name)))
1597 (and gnus-uu-ignore-files-by-type
1598 (string-match gnus-uu-ignore-files-by-type
1599 (or (gnus-uu-choose-action
1600 file-name gnus-uu-ext-to-mime-list t)
1605 (when (string-match (car rule) file-name)
1609 (defun gnus-uu-treat-archive (file-path)
1613 (setq action (gnus-uu-choose-action
1614 file-path (append gnus-uu-user-archive-rules
1615 (if gnus-uu-ignore-default-archive-rules
1617 gnus-uu-default-archive-rules))))
1625 (when (member action gnus-uu-destructive-archivers)
1628 (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
1631 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
1634 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
1636 (if (eq 0 (call-process shell-file-name nil
1637 (gnus-get-buffer-create gnus-uu-output-buffer-name)
1640 (gnus-message 2 "Error during unpacking of archive")
1643 (when (member action gnus-uu-destructive-archivers)
1648 (defun gnus-uu-dir-files (dir)
1653 (setq files (append files (gnus-uu-dir-files file)))
1658 (defun gnus-uu-unpack-files (files &optional ignore)
1660 (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
1664 (setq file (cdr (assq 'name (car files))))
1666 (equal (gnus-uu-get-action (file-name-nondirectory file))
1667 "gnus-uu-archive"))
1669 (unless (gnus-uu-treat-archive file)
1670 (gnus-message 2 "Error during unpacking of %s" file))
1671 (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
1675 (push (list (cons 'name (car nfiles))
1682 (gnus-uu-unpack-files ofiles (append did-unpack ignore))
1685 (defun gnus-uu-ls-r (dir)
1686 (let* ((files (gnus-uu-directory-files dir t))
1691 (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))
1697 (defun gnus-uu-directory-files (dir &optional full)
1703 (unless (member (file-name-nondirectory file) '("." ".."))
1708 (defun gnus-uu-check-correct-stripped-uucode (start end)
1711 (if (not gnus-uu-correct-stripped-uucode)
1725 (if (looking-at (concat gnus-uu-begin-string "\\|"
1726 gnus-uu-end-string))
1741 (defvar gnus-uu-tmp-alist nil)
1743 (defun gnus-uu-initialize (&optional scan)
1746 (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
1748 (setq gnus-uu-work-dir (cdr entry))
1749 (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
1752 (setq gnus-uu-tmp-dir (file-name-as-directory
1753 (expand-file-name gnus-uu-tmp-dir)))
1754 (if (not (file-directory-p gnus-uu-tmp-dir))
1755 (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
1756 (when (not (file-writable-p gnus-uu-tmp-dir))
1758 gnus-uu-tmp-dir)))
1760 (setq gnus-uu-work-dir
1761 (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
1762 (set-file-modes gnus-uu-work-dir 448)
1763 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
1764 (push (cons gnus-newsgroup-name gnus-uu-work-dir)
1765 gnus-uu-tmp-alist))))
1769 (defun gnus-uu-clean-up ()
1771 (and gnus-uu-uudecode-process
1772 (memq (process-status (or gnus-uu-uudecode-process "nevair"))
1774 (delete-process gnus-uu-uudecode-process))
1775 (when (setq buf (get-buffer gnus-uu-output-buffer-name))
1781 (defun gnus-uu-command (action file)
1787 (defun gnus-uu-delete-work-dir (&optional dir)
1788 "Delete recursively all files and directories under `gnus-uu-work-dir'."
1790 (gnus-message 7 "Deleting directory %s..." dir)
1791 (setq dir gnus-uu-work-dir))
1797 (unless (member (file-name-nondirectory file) '("." ".."))
1799 (gnus-uu-delete-work-dir file)
1800 (gnus-message 9 "Deleting file %s..." file)
1803 (error (gnus-message 3 "Deleting file %s failed... %s" file err))))))
1806 (error (gnus-message 3 "Deleting directory %s failed... %s" file err))))
1807 (gnus-message 7 "")))
1811 (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
1812 (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
1825 (defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
1827 There are three functions supplied with gnus-uu for encoding files:
1828 `gnus-uu-post-encode-uuencode', which does straight uuencoding;
1829 `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
1830 headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
1832 :group 'gnus-extract-post
1833 :type '(radio (function-item gnus-uu-post-encode-uuencode)
1834 (function-item gnus-uu-post-encode-mime)
1835 (function-item gnus-uu-post-encode-mime-uuencode)
1838 (defcustom gnus-uu-post-include-before-composing nil
1839 "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
1841 \\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article."
1842 :group 'gnus-extract-post
1845 (defcustom gnus-uu-post-length 990
1849 :group 'gnus-extract-post
1852 (defcustom gnus-uu-post-threaded nil
1853 "Non-nil means that gnus-uu will post the encoded file in a thread.
1856 one package that does that - gnus-uu, but somehow, I don't think that
1858 :group 'gnus-extract-post
1861 (defcustom gnus-uu-post-separate-description t
1867 :group 'gnus-extract-post
1870 (defvar gnus-uu-post-binary-separator "--binary follows this line--")
1871 (defvar gnus-uu-post-message-id nil)
1872 (defvar gnus-uu-post-inserted-file-name nil)
1873 (defvar gnus-uu-winconf-post-news nil)
1875 (defun gnus-uu-post-news ()
1878 (setq gnus-uu-post-inserted-file-name nil)
1879 (setq gnus-uu-winconf-post-news (current-window-configuration))
1881 (gnus-summary-post-news)
1886 ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
1887 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
1888 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
1889 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
1891 (when gnus-uu-post-include-before-composing
1892 (save-excursion (setq gnus-uu-post-inserted-file-name
1893 (gnus-uu-post-insert-binary)))))
1895 (defun gnus-uu-post-insert-binary-in-article ()
1897 The user will be asked for a file name."
1900 (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
1903 (defun gnus-uu-post-encode-uuencode (path file-name)
1904 (when (gnus-uu-post-encode-file "uuencode" path file-name)
1912 (defun gnus-uu-post-encode-mime-uuencode (path file-name)
1913 (when (gnus-uu-post-encode-uuencode path file-name)
1914 (gnus-uu-post-make-mime file-name "x-uue")
1918 (defun gnus-uu-post-encode-mime (path file-name)
1919 (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch
1920 (format "%s %s -o %s" "mmencode" path file-name)))
1921 (gnus-uu-post-make-mime file-name "base64")
1925 (defun gnus-uu-post-make-mime (file-name encoding)
1927 (insert (format "Content-Type: %s; name=\"%s\"\n"
1928 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
1929 file-name))
1932 (set-buffer gnus-message-buffer)
1934 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
1944 (defun gnus-uu-post-encode-file (command path file-name)
1945 (eq 0 (call-process shell-file-name nil t nil shell-command-switch
1946 (format "%s %s %s" command path file-name))))
1948 (defun gnus-uu-post-news-inews ()
1953 (let (file-name)
1955 (if gnus-uu-post-inserted-file-name
1956 (setq file-name gnus-uu-post-inserted-file-name)
1957 (setq file-name (gnus-uu-post-insert-binary)))
1959 (gnus-uu-post-encoded file-name gnus-uu-post-threaded))
1960 (setq gnus-uu-post-inserted-file-name nil)
1961 (when gnus-uu-winconf-post-news
1962 (set-window-configuration gnus-uu-winconf-post-news)))
1965 ;; the current buffer. Returns the file name the user gave.
1966 (defun gnus-uu-post-insert-binary ()
1967 (let ((uuencode-buffer-name "*uuencode buffer*")
1968 file-path uubuf file-name)
1970 (setq file-path (read-file-name
1976 (insert (format "\n%s\n" gnus-uu-post-binary-separator))
1983 (setq file-name (substring file-path (1+ (match-beginning 0))))
1984 (setq file-name file-path))
1989 (gnus-get-buffer-create uuencode-buffer-name)))
1991 (funcall gnus-uu-post-encode-method file-path file-name))
1995 file-name))
1998 (defun gnus-uu-post-encoded (file-name &optional threaded)
1999 (let ((send-buffer-name "*uuencode send buffer*")
2000 (encoded-buffer-name "*encoded buffer*")
2001 (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
2002 (separator (concat mail-header-separator "\n\n"))
2003 uubuf length parts header i end beg
2010 (if gnus-uu-post-separate-description
2011 (concat "^" (regexp-quote gnus-uu-post-binary-separator)
2013 (concat "^" (regexp-quote mail-header-separator) "$"))
2015 (error "Internal error: No binary/header separator"))
2022 (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name)))
2027 (setq parts (/ length gnus-uu-post-length))
2028 (unless (< (% length gnus-uu-post-length) 4)
2031 (when gnus-uu-post-separate-description
2037 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2039 (setq header (buffer-substring (point-min) (point)))
2042 (when gnus-uu-post-separate-description
2048 (setq gnus-uu-post-message-id (message-fetch-field "message-id")))
2054 (set-buffer (gnus-get-buffer-create send-buffer-name))
2056 (insert header)
2057 (when (and threaded gnus-uu-post-message-id)
2058 (insert "References: " gnus-uu-post-message-id "\n"))
2061 (- 62 (length (format top-string "" file-name i parts ""))))
2068 file-name i parts
2083 (forward-line gnus-uu-post-length))
2093 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2097 (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
2106 (setq gnus-uu-post-message-id
2110 (gnus-kill-buffer send-buffer-name)
2111 (gnus-kill-buffer encoded-buffer-name)
2113 (when (not gnus-uu-post-separate-description)
2118 (provide 'gnus-uu)
2121 ;;; gnus-uu.el ends here