home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / gnus-mail-vm.el < prev    next >
Encoding:
Text File  |  1993-03-03  |  2.1 KB  |  60 lines
  1. ;; LCD Archive Entry:
  2. ;; gnus-mail-vm|Joe Wells|jbw@cs.bu.edu|
  3. ;; Allow using VM's mail sending instead of the default version from GNUS.|
  4. ;; 1992-08-16||~/functions/gnus-mail-vm.el.Z|
  5.  
  6. ;;(setq gnus-mail-reply-method 'gnus-mail-reply-using-mail)
  7. (setq gnus-mail-reply-method 'gnus-mail-reply-using-vm)
  8.  
  9. (defun gnus-mail-reply-using-vm (&optional yank)
  10.   "Compose reply mail using VM.
  11. Optional argument YANK means yank original article."
  12.   ;; Ugly hack to work around fact that vm-mail-internal always uses
  13.   ;; switch-to-buffer.  Duplicate old GNUS functionality.
  14.   (save-excursion
  15.     (pop-to-buffer " *dummy buffer*"))
  16.   (save-restriction
  17.     (narrow-to-region (point-min) (progn (goto-line (point-min))
  18.                      (search-forward "\n\n")
  19.                      (- (point) 1)))
  20.     (vm-mail-internal
  21.      (format "reply to %s:%d" gnus-newsgroup-name gnus-current-article)     
  22.      (or (mail-fetch-field "reply-to")
  23.      (mail-fetch-field "from"))
  24.      (mail-fetch-field "subject")
  25.      nil nil
  26.      (concat (mail-fetch-field "references") " "
  27.          (mail-fetch-field "message-id"))
  28.      (mail-fetch-field "newsgroups")))
  29.   (gnus-handle-references)
  30.   (make-local-variable 'mail-reply-buffer)
  31.   (setq mail-reply-buffer gnus-Article-buffer)
  32.   (if yank
  33.       (let ((last (point)))
  34.     (goto-char (point-max))
  35.     ;; This will delete window on *Article* buffer
  36.     (mail-yank-original nil)
  37.     (goto-char last)
  38.     )))
  39.  
  40. ;; The references filling functionality should be moved to vm-mail-internal
  41. (defun gnus-handle-references (&rest additional-references)
  42.   (save-excursion
  43.     (mail-position-on-field "References")
  44.     (insert " " (mapconcat 'identity additional-references " "))
  45.     (save-restriction
  46.       (narrow-to-region (1+ (point))
  47.             (progn (re-search-backward "^[^ \t]")
  48.                    (point)))
  49.       (goto-char (point-min))
  50.       (while (re-search-forward "[ \t\n]+" nil 'move)
  51.     (replace-match " "))
  52.       (delete-char -1)
  53.       (insert ?\n)
  54.       (let ((fill-column 79)
  55.         (fill-prefix " "))        ; save space on screen
  56.     ;; Fold long references line to follow RFC1036.
  57.     ;; The region must end with a newline to fill the region
  58.     ;; without inserting extra newline.
  59.     (fill-region-as-paragraph (point-min) (point-max))))))
  60.