cgit.sxemacs.org Git - gnus/blob - lisp/nngateway.el

   1 ;;; nngateway.el --- posting news via mail gateways
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news, mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'cl))
  31 (require 'nnoo)
  32 (require 'message)
  33
  34 (nnoo-declare nngateway)
  35
  36 (defvoo nngateway-address nil
  37   "Address of the mail-to-news gateway.")
  38
  39 (defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
  40   "Function to be called to rewrite the news headers into mail headers.
  41 It is called narrowed to the headers to be transformed with one
  42 parameter -- the gateway address.")
  43
  44 ;;; Interface functions
  45
  46 (nnoo-define-basics nngateway)
  47
  48 (deffoo nngateway-open-server (server &optional defs)
  49   (if (nngateway-server-opened server)
  50       t
  51     (unless (assq 'nngateway-address defs)
  52       (setq defs (append defs (list (list 'nngateway-address server)))))
  53     (nnoo-change-server 'nngateway server defs)))
  54
  55 (deffoo nngateway-request-post (&optional server)
  56   (when (or (nngateway-server-opened server)
  57             (nngateway-open-server server))
  58     ;; Rewrite the header.
  59     (let ((buf (current-buffer)))
  60       (with-temp-buffer
  61         (insert-buffer-substring buf)
  62         (message-narrow-to-head)
  63         (funcall nngateway-header-transformation nngateway-address)
  64         (goto-char (point-max))
  65         (insert mail-header-separator "\n")
  66         (widen)
  67         (let (message-required-mail-headers)
  68           (funcall (or message-send-mail-real-function
  69                        message-send-mail-function)))
  70         t))))
  71
  72 ;;; Internal functions
  73
  74 (defun nngateway-simple-header-transformation (gateway)
  75   "Transform the headers to use GATEWAY."
  76   (let ((newsgroups (mail-fetch-field "newsgroups")))
  77     (message-remove-header "to")
  78     (message-remove-header "cc")
  79     (goto-char (point-min))
  80     (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
  81             "@" gateway "\n")))
  82
  83 (defun nngateway-mail2news-header-transformation (gateway)
  84   "Transform the headers for sending to a mail2news gateway."
  85   (message-remove-header "to")
  86   (message-remove-header "cc")
  87   (goto-char (point-min))
  88   (insert "To: " gateway "\n"))
  89
  90 (nnoo-define-skeleton nngateway)
  91
  92 (provide 'nngateway)
  93
  94 ;;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc
  95 ;;; nngateway.el ends here