home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnus-mark.el < prev    next >
Encoding:
Text File  |  1992-12-10  |  20.1 KB  |  536 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2.  
  3. ;;; gnus-mark.el v1.4
  4. ;;; Operating on more than one news article at a time.
  5. ;;; Created: 28-Jun-91 by Jamie Zawinski <jwz@lucid.com>
  6. ;;; Modified: 28-Jun-91 by Sebastian Kremer <sk@thp.Uni-Koeln.DE>
  7. ;;; Modified: 1-Dec-91 by Jamie Zawinski <jwz@lucid.com>
  8. ;;; Modified: 05-Dec-91 by Paul D. Smith <paul_smith@dg.com>
  9. ;;; Modified: 28-Nov-92 by A1C Tim Miller <tjm@hrt213.brooks.af.mil>
  10. ;;;
  11. ;;; typing `@' in the subject buffer will mark the current article with
  12. ;;; an `@'.  After marking more than one article this way, you can use one
  13. ;;; of the commands in this file on all of them at once.
  14. ;;;
  15. ;;; `M-@' will prompt you for a regular expression, and will mark all f
  16. ;;; articles which match.
  17. ;;;
  18. ;;; `^U@' will prompt you for a mark-character to use other than `@'.
  19. ;;;
  20. ;;; To unmark an article, use `u', `d', or `^U M-@ SPC RET'.
  21. ;;;
  22. ;;; `F' (gnus-forward-marked-articles) will put you in a send-mail buffer 
  23. ;;; along with the contents of all of the marked articles in RFC-944 digest
  24. ;;; format, suitable for later explosion with any reasonable mail reader.
  25. ;;;
  26. ;;; `M-x gnus-uudecode-marked-messages' (M-x gnus-uu RET works) will strip the
  27. ;;; junk from the beginning and end of the marked articles, concatenate them
  28. ;;; together, and pipe the result through uudecode.  If the resultant file is
  29. ;;; a tar file and/or is compressed, this command offers to unpack/uncompress
  30. ;;; as well.  See also the variables gnus-uudecode-file-mode, 
  31. ;;; gnus-uudecode-auto-chmod, and gnus-uudecode-auto-touch.  If the first
  32. ;;; marked message is not the first part of the uuencoded file, or if the last
  33. ;;; marked message is not the last part of the uuencoded file, it complains.
  34. ;;; However, it's not possible to tell if the middle parts are out of order,
  35. ;;; so make sure you use ^C^S^S to get the articles in the right order first.
  36. ;;; It also complains about obviously-corrupted files.
  37. ;;;
  38. ;;; `M-x gnus-unshar-marked-articles' (M-x gnus-un RET works) will strip the 
  39. ;;; junk from the beginning and end of the marked articles, and run each of
  40. ;;; them through sh in turn.  This doesn't work on shar files that don't 
  41. ;;; begin with "#!".
  42. ;;;
  43. ;;; Both of the above commands prompt you for a directory in which to do the
  44. ;;; dirty work.  If the directory you specify doesn't exist, you have the
  45. ;;; option of creating it.
  46. ;;;
  47. ;;; M-x gnus-save-marked-articles-in-file will save marked articles in a file;
  48. ;;; prompts with gnus' standard filename query for each article unless
  49. ;;; gnus-save-marked-in-same-file is non-nil.
  50. ;;
  51. ;; LCD Archive Entry:
  52. ;; gnus-mark|Jamie Zawinski|jwz@lucid.com
  53. ;; |Operate on more than one news article at a time
  54. ;; |92-11-30||~/misc/gnus-mark.el.Z|
  55.  
  56. ;; 05 Dec 91 pds - Paul D. Smith (paul_smith@dg.com)
  57. ;;
  58. ;;  * Changed the key binding for gnus-forward-marked-articles to C-f
  59. ;;    instead of F: `F' is Followup-yank-original which is a very
  60. ;;    common function!
  61. ;;
  62. ;;  * Added local gnus-mark-shell-command function which performs
  63. ;;    more exactly what we want to happen; namely allows the shell
  64. ;;    output buffer to be displayed before the command is executed and
  65. ;;    to be filled real-time.  It will either erase the buffer or just
  66. ;;    add text to the end.
  67. ;;
  68. ;;  * Fixed a bug where if you had one of the articles you marked
  69. ;;    actually read in when you used one of the three mark processing
  70. ;;    commands the mark would not be deleted.
  71. ;;
  72. ;;  * Modified gnus-Subject-mark-article to use GNUS functions to do
  73. ;;    the marking instead of modifying the character itself.  This
  74. ;;    keeps the cursor in the right position in the buffer, doesn't
  75. ;;    allow it to go beyond the end of the buffer even if you select
  76. ;;    the last article, etc.
  77.  
  78. (require 'gnus)
  79.  
  80. (define-key gnus-Subject-mode-map "@" 'gnus-Subject-mark-article)
  81. (define-key gnus-Subject-mode-map "\C-F" 'gnus-forward-marked-articles)
  82. (define-key gnus-Subject-mode-map "\M-@" 'gnus-Subject-mark-regexp)
  83. ;;; See also gnus-uudecode-marked-messages and gnus-unshar-marked-articles.
  84.  
  85. (defvar gnus-default-mark-char ?@
  86.   "*Character used to mark articles for later commands in GNUS.")
  87.  
  88. (defun gnus-Subject-mark-article (mark)
  89. "Mark the current article for later commands.
  90. This marker comes from variable `gnus-default-mark-char'.
  91. You can change this variable by giving a prefix argument to this command,
  92. in which case you will be prompted for the character to use."
  93.   (interactive (list (if current-prefix-arg
  94.              (let ((cursor-in-echo-area t))
  95.                (message "Mark message with: ")
  96.                (setq gnus-default-mark-char (read-char)))
  97.              gnus-default-mark-char)))
  98.   (or (eq (current-buffer) (get-buffer gnus-Subject-buffer))
  99.       (error "not in subject buffer"))
  100.   (gnus-Subject-mark-as-read nil gnus-default-mark-char)
  101.   (gnus-Subject-next-subject 1 nil))
  102.  
  103. ;; Actually, gnus-kill should have an interactive spec!
  104. (defun gnus-Subject-mark-regexp (regexp &optional marker)
  105.   "Mark all articles with subjects matching REGEXP.
  106. With a prefix ARG, prompt for the marker.  Type RET immediately to
  107. mark them as unread or enter SPC RET to remove all kinds of marks."
  108.   (interactive
  109.    (list (read-string "Mark (regexp): ")
  110.      (if current-prefix-arg
  111.          (read-string
  112.           "Mark with char (RET to mark as unread, SPC RET to remove existing markers): "))))
  113.   (setq marker (or marker (char-to-string gnus-default-mark-char)))
  114.   (gnus-kill "Subject" regexp
  115.          (if (equal "" marker)
  116.          '(gnus-Subject-mark-as-unread)
  117.            (list 'gnus-Subject-mark-as-read nil marker))
  118.          ;; overwrite existing marks:
  119.          t))
  120.  
  121. (defun gnus-Subject-mark-map-articles (mark function)
  122.   (save-excursion
  123.     (set-buffer gnus-Subject-buffer)
  124.     (let ((str (concat "^" (make-string 1 mark) " +\\([0-9]+\\):"))
  125.       got-one)
  126.       (save-excursion
  127.     (goto-char (point-min))
  128.     (while (not (eobp))
  129.       (if (looking-at str)
  130.           (progn
  131.         (setq got-one t)
  132.         (save-excursion
  133.           (funcall function
  134.             (gnus-find-header-by-number gnus-newsgroup-headers 
  135.               (string-to-int
  136.             (buffer-substring
  137.               (match-beginning 1) (match-end 1))))))))
  138.       (forward-line 1)))
  139.       (cond ((not got-one)
  140.          (let ((article (gnus-Subject-article-number)))
  141.            (if (or (null gnus-current-article)
  142.                (/= article gnus-current-article))
  143.            ;; Selected subject is different from current article's.
  144.            (gnus-Subject-display-article article))
  145.            (funcall function 
  146.             (gnus-find-header-by-number gnus-newsgroup-headers 
  147.                             article)))))
  148.       )))
  149.  
  150.  
  151. ;;; simpler, more specific to gnus-mark version of shell-command
  152.  
  153. (defun gnus-mark-shell-command (start end command erase)
  154.   "Execute string COMMAND in inferior shell with region as input.
  155. Display output (if any) in temp buffer interactively.
  156. If ERASE is non-nil the buffer is erased, otherwise the output is
  157. appended to the end of the buffer."
  158.     (let ((buffer (get-buffer-create "*Shell Command Output*"))
  159.       (orig-buffer (current-buffer)))
  160.       (set-buffer buffer)
  161.       (if erase
  162.       (erase-buffer)
  163.     (goto-char (point-max)))
  164.       (set-buffer orig-buffer)
  165.       (if (eq buffer orig-buffer)
  166.       (setq start 1 end 1))
  167.       (display-buffer buffer)
  168.       (bury-buffer buffer)
  169.       (call-process-region start end shell-file-name
  170.                nil buffer t "-c" command)))
  171.  
  172.  
  173. ;;; RFC944 forwarding of multiple messages
  174.  
  175. (defun gnus-forward-marked-articles ()
  176.   "Forward the marked messages to another user, RFC944 style."
  177.   (interactive)
  178.   (let (subj p
  179.     (state 'first)
  180.     tmp-buf)
  181.     (unwind-protect
  182.     (progn
  183.       (setq tmp-buf (get-buffer-create "*gnus-forward-tmp*"))
  184.       (save-excursion (set-buffer tmp-buf) (erase-buffer))
  185.       (gnus-Subject-mark-map-articles
  186.        gnus-default-mark-char
  187.        (function (lambda (msg)
  188.          (if (eq state 'first) (setq state t) (setq state nil))
  189.          (message "Snarfing article %s..." (aref msg 0))
  190.          (if (eq gnus-current-article (aref msg 0))
  191.          (gnus-Subject-mark-as-read)
  192.            (gnus-Subject-display-article (aref msg 0)))
  193.          (set-buffer gnus-Article-buffer)
  194.          (widen)
  195.          (set-buffer tmp-buf)
  196.          (goto-char (point-max))
  197.          (if subj
  198.          (insert "----------\n")
  199.            (setq subj (aref msg 1)))
  200.          (setq p (point))
  201.          (insert-buffer gnus-Article-buffer)
  202.          (goto-char p)
  203.          (while (re-search-forward "^-" nil t)
  204.            (insert " -"))
  205.          )))
  206.       (mail nil nil (concat "[Fwd: " subj "]"))
  207.       (save-excursion
  208.         (goto-char (point-max))
  209.         (insert (if state
  210.             "---------- Begin forwarded message\n"
  211.               "---------- Begin digest\n"))
  212.         (insert-buffer tmp-buf)
  213.         (goto-char (point-max))
  214.         (insert (if state
  215.             "\n---------- End forwarded message\n"
  216.               "\n---------- End digest\n"))))
  217.       ;; protected
  218.       (and tmp-buf (kill-buffer tmp-buf)))))
  219.  
  220.  
  221. ;;; reading a directory name, and offering to create if it doesn't exist.
  222.  
  223. (defun gnus-mark-read-directory (prompt &optional default-dir)
  224.   (let ((dir
  225.      (read-file-name prompt
  226.              (or default-dir default-directory)
  227.              (or default-dir default-directory))))
  228.     (if (string-match "/$" dir)
  229.     (setq dir (substring dir 0 (match-beginning 0))))
  230.     (setq dir
  231.       (cond ((file-directory-p dir) dir)
  232.         ((file-exists-p dir)
  233.          (ding)
  234.          (message "%s exists and is not a directory!" dir)
  235.          (sleep-for 2)
  236.          (gnus-mark-read-directory prompt dir))
  237.         ((y-or-n-p (format "directory %s doesn't exist, create it? " dir))
  238.          (make-directory dir)
  239.          dir)
  240.         (t (gnus-mark-read-directory prompt dir))))
  241.     (if (string-match "/$" dir)
  242.     dir
  243.       (concat dir "/"))))
  244.  
  245.  
  246. ;;; uudecode
  247.  
  248. (defconst gnus-uudecode-begin-pattern
  249.     "^begin[ \t]+\\([0-9][0-9][0-9][0-9]?\\)[ \t]+\\([^ \t\n]*\\)$")
  250.  
  251. (defconst gnus-uudecode-body-pattern
  252.     "^M.............................................................?$")
  253.  
  254. (defconst gnus-uudecode-begin-or-body-pattern
  255.     (concat "\\(" gnus-uudecode-begin-pattern "\\|"
  256.         gnus-uudecode-body-pattern "\\)"))
  257.  
  258. (defvar gnus-uudecode-file-mode "644"
  259.   "*If non-nil, this overrides the mode specified in the `begin' line of
  260. a uuencoded file being unpacked by vm-uudecode.  This should be a string,
  261. which is the mode desired in octal.")
  262.  
  263. (defvar gnus-uudecode-auto-chmod "u+w"
  264.   "*If non-nil, then when gnus is untarring a file for you, it will
  265. apply this chmod modifier to each of the unpacked files.  This should be
  266. a string like \"u+w\".")
  267.  
  268. (defvar gnus-uudecode-auto-touch t
  269.   "*If non-nil, then when vm-uudecode is untarring a file for you, it will
  270. cause the write-date of each of the unpacked files to be the current time.
  271. Normally tar unpacks files with the time at which they are packed; this can
  272. cause your `make' commands to fail if you are installing a new version of
  273. a package which you have modified.")
  274.  
  275. (defvar gnus-uudecode-picture-pattern "\\.\\(gif\\|p[bgp]m\\|rast\\|pic\\|jpg\\)$"
  276.   "*If non-nil, this should be a pattern which matches files which are 
  277. images.  When gnus-uudecode-marked-articles creates a file which matches
  278. this pattern, it will ask you if you want to look at it now.  If so, it
  279. invokes gnus-uudecode-picture-viewer with the filename as an argument.
  280. After doing this, it asks you if you want to keep the picture or delete it.")
  281.  
  282. (defvar gnus-uudecode-picture-viewer "xv"
  283.   "*The picture viewer that gnus-uudecode-marked-messages uses.  See doc of
  284. variable gnus-uudecode-picture-pattern.")
  285.  
  286. (defvar gnus-uudecode-default-directory nil "*")
  287.  
  288. (defun gnus-uudecode-marked-articles (directory)
  289.   "Strip the junk from the beginning and end of the marked articles, 
  290. concatenate them together, and pipe the result through uudecode.  If
  291. the resultant file is a tar file and/or is compressed, this command
  292. offers to unpack/uncompress as well.  See also the variables
  293. gnus-uudecode-file-mode, gnus-uudecode-auto-chmod, and
  294.  gnus-uudecode-auto-touch."
  295.   (interactive (list (gnus-mark-read-directory "uudecode in directory: "
  296.                gnus-uudecode-default-directory)))
  297.   (setq gnus-uudecode-default-directory directory)
  298.   (let ((state 'first)
  299.     tmp-buf
  300.     name)
  301.     (unwind-protect
  302.       (progn
  303.        (setq tmp-buf  (get-buffer-create "*gnus-uudecode-tmp*"))
  304.        (save-excursion (set-buffer tmp-buf) (erase-buffer))
  305.        (gnus-Subject-mark-map-articles
  306.     gnus-default-mark-char
  307.     (function (lambda (msg)
  308.       (message "Snarfing article %s..." (aref msg 0))
  309.       (if (eq state 'last)
  310.           (error "articles out of order: articles follow `end' line."))
  311.       (if (eq gnus-current-article (aref msg 0))
  312.           (gnus-Subject-mark-as-read)
  313.         (gnus-Subject-display-article (aref msg 0)))
  314.       (set-buffer gnus-Article-buffer)
  315.       (widen)
  316.       (set-buffer tmp-buf)
  317.       (goto-char (point-max))
  318.       (let ((p (point))
  319.         (case-fold-search nil))
  320.         (insert-buffer gnus-Article-buffer)
  321.         (cond
  322.          ((eq state 'first)
  323.           (or (re-search-forward gnus-uudecode-begin-pattern nil t)
  324.           (error "couldn't find `begin' line in first article."))
  325.           ;; I'd like to second-guess the losers who use mixed-case
  326.           ;; and upper-case filenames, but this trashes trailing ".Z"
  327.           ;;(downcase-region (match-beginning 2) (match-end 2))
  328.           (setq name (buffer-substring (match-beginning 2) (match-end 2)))
  329.           ;; don't tolerate bogus umasks.
  330.           (if gnus-uudecode-file-mode
  331.           (progn
  332.             (goto-char (match-beginning 1))
  333.             (delete-region (match-beginning 1) (match-end 1))
  334.             (insert gnus-uudecode-file-mode)))
  335.           (setq state 'middle))
  336.          (t
  337.           (or (re-search-forward gnus-uudecode-begin-or-body-pattern nil t)
  338.           (error "couldn't find beginning of data."))))
  339.         (beginning-of-line)
  340.         (delete-region p (point))
  341.         (let (c len tmp)
  342.           ;; This could be sped up a lot, but then we'd lose the
  343.           ;; error checking it does; maybe that's ok.
  344.           (while (progn
  345.                (forward-line)
  346.                (setq c (- (following-char) ? ))
  347.                (end-of-line)
  348.                (setq tmp (/ (1- (current-column)) 4))
  349.                (beginning-of-line)
  350.                (= (+ tmp (+ tmp tmp)) c))
  351.         )
  352.           ;; Slack.
  353.           (setq p (point))
  354.           (if (or (looking-at "end\n")
  355.               (progn (forward-line 1) (looking-at "end\n"))
  356.               (progn (forward-line 1) (looking-at "end\n"))
  357.               (progn (forward-line 1) (looking-at "end\n")))
  358.           (progn
  359.             (forward-line 1)
  360.             (setq state 'last))
  361.         (goto-char p))
  362.           )
  363.         (delete-region (point) (point-max))))))
  364.        (or (eq state 'last) (error "no `end' line in last article."))
  365.        (set-buffer tmp-buf)
  366.        (let* ((base-file (file-name-nondirectory name))
  367.           (final-file (concat directory base-file))
  368.           (command (concat "cd " directory " ; uudecode"))
  369.           tar-p)
  370.      (cond ((string-match "\\.tar\\.Z$" base-file)
  371.         (if (y-or-n-p "uncompress/untar? ")
  372.             (setq command (concat command " && zcat "
  373.                       base-file " | tar -vxf -")
  374.               final-file nil
  375.               tar-p t)))
  376.            ((string-match "\\.tar$" base-file)
  377.         (if (y-or-n-p "untar? ")
  378.             (setq command (concat command " && tar -vxf " base-file)
  379.               final-file nil
  380.               tar-p t)))
  381.            ((string-match "\\.Z$" base-file)
  382.         (if (y-or-n-p "uncompress? ")
  383.             (setq command (concat command " ; uncompress " base-file)
  384.               final-file (substring base-file 0
  385.                         (match-beginning 0))))))
  386.      (let ((str (concat "executing \"" command "\" ...")))
  387.        (message str)
  388.        (gnus-mark-shell-command (point-min) (point-max) command t)
  389. ;       (if final-file
  390. ;          (dired-add-entry-all-buffers directory
  391. ;         (file-name-nondirectory final-file)))
  392.        (message (concat str " done.")))
  393.      (cond
  394.       (tar-p
  395.        (set-buffer (get-buffer "*Shell Command Output*"))
  396.        (let ((all (concat command "\n" (buffer-string)))
  397.          files files-str)
  398.          (goto-char (point-min))
  399.          (while (not (eobp))
  400.            (if (looking-at "^x \\([^,\n]+\\), ")
  401.            (setq files (cons (buffer-substring
  402.                       (match-beginning 1) (match-end 1))
  403.                      files)))
  404.            (forward-line 1))
  405.          (setq files (nreverse files)
  406.            files-str (mapconcat 'identity files " "))
  407.          (cond
  408.           (files
  409.            (cond
  410.         (gnus-uudecode-auto-chmod
  411.          (setq command (concat "cd " directory " ; chmod "
  412.                        gnus-uudecode-auto-chmod " " files-str))
  413.          (gnus-mark-shell-command (point) (point) command nil)
  414.          (setq all (concat all "\n" command "\n" (buffer-string)))))
  415.            (cond
  416.         (gnus-uudecode-auto-touch
  417.          (setq command (concat "cd " directory " ; touch " files-str))
  418.          (gnus-mark-shell-command (point) (point) command nil)
  419.          (setq all (concat all "\n" command "\n" (buffer-string)))))
  420.           (goto-char (point-min))
  421.           (insert all "\n")
  422. ;          (mapcar (function (lambda (x)
  423. ;            (dired-add-entry-all-buffers directory x)))
  424. ;              files)
  425.           ))))
  426.       (t
  427.        (message "wrote file %s" final-file)
  428.        (let ((case-fold-search t))
  429.          (cond ((null gnus-uudecode-picture-pattern) nil)
  430.            ((and (string-match gnus-uudecode-picture-pattern
  431.                        final-file)
  432.              (y-or-n-p
  433.                (format "look at the picture in %s? " final-file)))
  434.             (gnus-mark-shell-command (point) (point)
  435.               (if (string-match (regexp-quote directory) final-file)
  436.               (concat "cd " directory " ; "
  437.                                   gnus-uudecode-picture-viewer " "
  438.                   (substring final-file (match-end 0)))
  439.             (concat gnus-uudecode-picture-viewer " " final-file))
  440.               nil)
  441.             (if (y-or-n-p (format "delete file %s? " final-file))
  442.             (progn
  443.               (delete-file final-file)
  444.               (message "%s deleted." final-file))
  445.             )
  446.             (display-buffer "*Article*")))))
  447.       )))
  448.       ;; protected
  449.       (and tmp-buf (kill-buffer tmp-buf)))))
  450.  
  451.  
  452. ;;; shar (ack pffleughhh barf)
  453.  
  454. (defvar gnus-unshar-program "/bin/sh"
  455.   "*The program to use to unshar files; you might want to use something
  456. that is less of a gaping security hole than /bin/sh.")
  457.  
  458. (defvar gnus-unshar-default-directory nil "*")
  459.  
  460. (defun gnus-unshar-marked-articles (directory)
  461.   "For each of the marked articles, strip the junk from the beginning and end
  462. and then run the result through gnus-unshar-program (typically /bin/sh.)"
  463.   (interactive (list (gnus-mark-read-directory
  464.                "unshar in directory: " gnus-unshar-default-directory)))
  465.   (setq gnus-unshar-default-directory directory)
  466.   (let (tmp-buf
  467.     (command (concat "cd " directory " ; " gnus-unshar-program)))
  468.     (unwind-protect
  469.       (progn
  470.        (if (setq tmp-buf (get-buffer "*Shell Command Output*"))
  471.        (save-excursion
  472.          (set-buffer tmp-buf)
  473.          (erase-buffer)))
  474.        (setq tmp-buf (get-buffer-create "*gnus-unshar-tmp*"))
  475.        (gnus-Subject-mark-map-articles
  476.     gnus-default-mark-char
  477.     (function (lambda (msg)
  478.       (message "Snarfing article %s..." (aref msg 0))
  479.       (if (eq gnus-current-article (aref msg 0))
  480.           (gnus-Subject-mark-as-read)
  481.         (gnus-Subject-display-article (aref msg 0)))
  482.       (set-buffer gnus-Article-buffer)
  483.       (widen)
  484.       (set-buffer tmp-buf)
  485.       (erase-buffer)
  486.       (insert-buffer gnus-Article-buffer)
  487.       (or (re-search-forward "^#!" nil t)
  488.           (re-search-forward "^: This is a shar archive" nil t)
  489.           (re-search-forward "^# This is a shell archive" nil t)
  490.           (re-search-forward "^# type \"sh file -c\"." nil t)
  491.           (re-search-forward "^#!" nil nil)) ; for the error message
  492.       (beginning-of-line)
  493.       (delete-region (point-min) (point))
  494.       (goto-char (point-max))
  495.       ;; what kind of shithead has a signature after a shar file?
  496.       (if (re-search-backward "^--" nil t)
  497.           (delete-region (point) (point-max)))
  498.       (message "unsharing article %s..." (aref msg 0))
  499.       (gnus-mark-shell-command (point-min) (point-max) command nil)
  500.       (message "unsharing article %s...done." (aref msg 0))
  501.       ))))
  502.       ;; protected
  503.       (kill-buffer tmp-buf)
  504. ;      (if (y-or-n-p "Display *Article* buffer? ")
  505. ;      (display-buffer "*Article*"))
  506.       )))
  507.  
  508. (defvar gnus-save-marked-in-same-file nil
  509.   "*Tells GNUS whether or not to prompt for a filename for each marked 
  510. article being saved.")
  511.  
  512. ;;; Save marked articles in a file
  513. ;;; Started: 28 Nov 92, because I need this kind of functionality
  514. ;;; By: A1C Tim Miller, tjm@hrt213.brooks.af.mil
  515. ;;; Map the function down the marked articles that grabs the article
  516. ;;; and saves it in a file, requesting a filename to save in
  517.  
  518. (defun gnus-save-marked-articles-in-file ()
  519.   "Save marked messages in a file."
  520.   (interactive)
  521.   (let ((state 'first))
  522.     (unwind-protect
  523.     (progn
  524.       (gnus-Subject-mark-map-articles
  525.        gnus-default-mark-char
  526.        (function (lambda (msg)
  527.                (if (eq state 'first) (setq state t) (setq state nil))
  528.                (message "Grabbing Article %s..." (aref msg 0))
  529.                (or (eq gnus-current-article (aref msg 0))
  530.                (gnus-Subject-display-article (aref msg 0)))
  531.                (if (and (not state) gnus-save-marked-in-same-file)
  532.                (gnus-Subject-save-in-file gnus-newsgroup-last-file)
  533.              (gnus-Subject-save-in-file)))))))))
  534.  
  535. (provide 'gnus-mark)
  536.