home *** CD-ROM | disk | FTP | other *** search
/ Big Green CD 8 / BGCD_8_Dev.iso / NEXTSTEP / UNIX / Mail / appnmail-1.8-Solaris / mailapp-utilities / gnus-mailapp.el < prev    next >
Encoding:
Text File  |  1996-11-24  |  7.3 KB  |  185 lines
  1. ; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         gnus-mailapp.el
  5. ; RCS:          /usr/local/sources/CVS/mailapp-utilities/gnus-mailapp.el,v 1.1.1.1 1996/11/24 14:56:15 tom Exp
  6. ; Description:  Make gnus work with Mail.app
  7. ; Author:       Carl Edman
  8. ; Created:      Sat Jun  5 09:49:56 1993
  9. ; Modified:     Tue May 31 16:17:51 1994 (Carl Edman) cedman@capitalist.princeton.edu
  10. ; Language:     Emacs-Lisp
  11. ; Package:      N/A
  12. ; Status:       Experimental (Do Not Distribute)
  13. ;
  14. ; (C) Copyright 1993, but otherwise this file is perfect freeware.
  15. ;
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;
  18. ; This package requires Emacs 19 and Gnus 3.15+
  19. ;
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;
  22. ; Load this package after loading gnus.el. You could automate that by
  23. ; adding this line to your ~/.emacs file:
  24. ;
  25. ;   (eval-after-load "gnus" '(load-library "gnus-mailapp"))
  26. ;
  27. ; To automatically mail yourself all articles you post, add these lines:
  28. ;
  29. ;   (add-hook 'gnus-inews-article-hook 'gnus-author-copy-save-in-nextmail)
  30. ;
  31. ; To use Mail.app as the default mailer inside gnus, add these lines:
  32. ;
  33. ;   (setq gnus-mail-reply-method 'gnus-mail-reply-using-nextmail
  34. ;         gnus-mail-forward-method 'gnus-mail-forward-using-nextmail
  35. ;         gnus-mail-other-window-method 'gnus-mail-other-window-using-nextmail)
  36. ;
  37. ; To have signatures which depend on the newsgroup:
  38. ;
  39. ;   (add-hook 'news-setup-hook 'gnus-insert-newsgroup-signature)
  40. ;
  41. ; To add a note to mail sent to authors of articles (when
  42. ; gnus-auto-mail-to-author is set):
  43. ;
  44. ;   (setq gnus-mail-send-method (function gnus-mail-send-with-note)
  45. ;         gnus-auto-mail-to-author-note "Text to use\n\n")
  46. ;
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48.  
  49. (require 'gnus)
  50.  
  51. (defun gnus-summary-save-in-directory (&optional dirname)
  52.   "Save article in directory."
  53.   (interactive)
  54.   (gnus-summary-select-article
  55.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  56.   (gnus-eval-in-buffer-window gnus-article-buffer
  57.     (save-excursion
  58.       (save-restriction
  59.         (widen)
  60.         (let ((filename (concat dirname (int-to-string (gnus-header-number gnus-current-headers)))))
  61.           (gnus-make-directory (file-name-directory filename))
  62.           (gnus-output-to-file filename))))))
  63.  
  64. (defun gnus-summary-save-all-articles (&optional dir)
  65.   "Save all articles in the current summary buffer which haven't been marked
  66. in the specified directory."
  67.   (interactive "FSave all articles in directory: ")
  68.   (if (not (string-match "/$" dir))
  69.       (setq dir (concat dir "/")))
  70.   (goto-char (point-min))
  71.   (gnus-execute "Subject" ".*" '(gnus-summary-save-in-directory dir) nil t))
  72.  
  73. (defun gnus-author-copy-save-in-nextmail (&optional file-name)
  74.   "Mail yourself all articles which you post."
  75.   (let ((newsgroups (gnus-fetch-field "newsgroups"))
  76.         (artbuf (current-buffer))
  77.         (tmpbuf (get-buffer-create " tmp-art")))
  78.     (save-excursion
  79.       (set-buffer tmpbuf)
  80.       (erase-buffer)
  81.       (insert-buffer-substring artbuf)
  82.       (goto-char (point-min))
  83.       (if newsgroups
  84.           (cond
  85.            ((re-search-forward "^\\(From: .*\\)(.*)\\(.*\\)$" nil t) 
  86.             (replace-match (concat "\\1(To: " newsgroups ")\\2")))
  87.            ((re-search-forward "^\\(From: .*\\)$" nil t)
  88.             (replace-match (concat "\\1 (To: " newsgroups ")")))
  89.            ((re-search-forward "\n\n")
  90.             (replace-match (concat "\nFrom: " (user-login-name) " (To: " newsgroups ")\n\n")))))
  91.       (call-process-region (point-min) (point-max) sendmail-program nil nil nil (user-login-name))
  92.       (kill-buffer tmpbuf))))
  93.  
  94. (defun gnus-summary-save-in-nextmail ()
  95.   "Mail yourself the current article."
  96.   (interactive)
  97.   (gnus-summary-select-article
  98.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  99.   (gnus-eval-in-buffer-window gnus-article-buffer
  100.     (save-excursion
  101.       (save-restriction
  102.         (widen)
  103.         (call-process-region (point-min) (point-max) sendmail-program nil nil nil (user-login-name))))))
  104.  
  105. (defun gnus-mail-reply-using-nextmail (&optional yank)
  106.   "Reply to current article in Mail.app."
  107.   (save-excursion (save-restriction
  108.     (widen)
  109.     (let* ((to (or (gnus-fetch-field "reply-to") (gnus-fetch-field "from") ""))
  110.            (rsubject (or (gnus-fetch-field "subject") ""))
  111.            (subject (if (string-match "^[Rr][Ee]:.+$" rsubject)
  112.                         rsubject (concat "Re: " rsubject)))
  113.            (text (save-excursion (goto-char (point-min))
  114.                                  (search-forward "\n\n" nil 'move)
  115.                                  (point)))
  116.            (start (point-min))
  117.            (end (if yank (point-max) text)))
  118.       (call-process-region start end "nextmail" nil nil nil "-s" subject "-e" to))))
  119.   (gnus-article-show-summary))
  120.  
  121. (defun gnus-mail-forward-using-nextmail (&optional yank)
  122.   "Forward current article in Mail.app."
  123.   (save-excursion (save-restriction
  124.     (widen)
  125.     (let* ((to (read-string "To: "))
  126.            (rsubject (or (gnus-fetch-field "subject") ""))
  127.            (subject (concat "[" gnus-newsgroup-name "] " rsubject))
  128.            (start) (end) (artbuf) (tmpbuf))
  129.       (setq artbuf (current-buffer)
  130.             tmpbuf (get-buffer-create " tmp-art"))
  131.       (set-buffer tmpbuf)
  132.       (erase-buffer)
  133.       (insert "------- Start of forwarded message -------\n")
  134.       (insert-buffer-substring artbuf)
  135.       (insert "------- End of forwarded message -------\n")
  136.       (setq start (point-min)
  137.             end (point-max))
  138.       (call-process-region start end "nextmail" nil nil nil "-s" subject "-e" to)
  139.       (kill-buffer tmpbuf))))
  140.   (gnus-article-show-summary))
  141.  
  142. (defun gnus-mail-other-window-using-nextmail (&optional yank)
  143.   "Send mail in Mail.app."
  144.   (save-excursion (save-restriction
  145.     (widen)
  146.     (let* ((to (read-string "To: "))
  147.            (subject (read-string "Subject: " (gnus-fetch-field "subject")))
  148.            (text (save-excursion (goto-char (point-min))
  149.                                  (search-forward "\n\n" nil 'move)
  150.                                  (point)))
  151.            (start (point-min))
  152.            (end (if yank (point-max) text)))
  153.       (call-process-region start end "nextmail" nil nil nil "-s" subject "-e" to))))
  154.   (gnus-article-show-summary))
  155.  
  156. (defun gnus-insert-newsgroup-signature ()
  157.   "Use in news-setup-hook to add newsgroup specific signature."
  158.   (save-excursion
  159.     (cond
  160.      ((file-exists-p (concat "~/News/" gnus-newsgroup-name ".SIG"))
  161.       (goto-char (point-max))
  162.       (insert "--\n")
  163.       (insert-file-contents (concat "~/News/" gnus-newsgroup-name ".SIG")))
  164.      ((file-exists-p "~/News/SIG")
  165.       (goto-char (point-max))
  166.       (insert "--\n")
  167.       (insert-file-contents "~/News/SIG")))))
  168.  
  169. (defvar gnus-auto-mail-to-author-note
  170.   "[NOTE: This is an automatically generated copy of a posted article]\n\n"
  171.   "Short string to prepend to mail sent to author if 'gnus-auto-mail-to-author'.")
  172.  
  173. (defun gnus-mail-send-with-note ()
  174.   "Add note to mail sent to author if 'gnus-auto-mail-to-author'."
  175.   (goto-char (point-min))
  176.   (search-forward (concat "\n" mail-header-separator "\n"))
  177.   (let ((p (point)))
  178.     (if gnus-auto-mail-to-author-note
  179.         (insert gnus-auto-mail-to-author-note))
  180.     (funcall send-mail-function)
  181.     (delete-region p (point))))
  182.  
  183. (define-key gnus-summary-mode-map "O" 'gnus-summary-save-all-articles)
  184.  
  185.