]> code.delx.au - gnu-emacs/blob - lisp/gnus/nngateway.el
Add 2012 to FSF copyright years for Emacs files (do not merge to trunk)
[gnu-emacs] / lisp / gnus / 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, 2006, 2007, 2008, 2009, 2010, 2011, 2012 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 3 of the License, or
14 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval-when-compile (require 'cl))
29 (require 'nnoo)
30 (require 'message)
31
32 (nnoo-declare nngateway)
33
34 (defvoo nngateway-address nil
35 "Address of the mail-to-news gateway.")
36
37 (defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
38 "Function to be called to rewrite the news headers into mail headers.
39 It is called narrowed to the headers to be transformed with one
40 parameter -- the gateway address.")
41
42 ;;; Interface functions
43
44 (nnoo-define-basics nngateway)
45
46 (deffoo nngateway-open-server (server &optional defs)
47 (if (nngateway-server-opened server)
48 t
49 (unless (assq 'nngateway-address defs)
50 (setq defs (append defs (list (list 'nngateway-address server)))))
51 (nnoo-change-server 'nngateway server defs)))
52
53 (deffoo nngateway-request-post (&optional server)
54 (when (or (nngateway-server-opened server)
55 (nngateway-open-server server))
56 ;; Rewrite the header.
57 (let ((buf (current-buffer)))
58 (with-temp-buffer
59 (insert-buffer-substring buf)
60 (message-narrow-to-head)
61 (funcall nngateway-header-transformation nngateway-address)
62 (goto-char (point-max))
63 (insert mail-header-separator "\n")
64 (widen)
65 (let (message-required-mail-headers)
66 (funcall (or message-send-mail-real-function
67 message-send-mail-function)))
68 t))))
69
70 ;;; Internal functions
71
72 (defun nngateway-simple-header-transformation (gateway)
73 "Transform the headers to use GATEWAY."
74 (let ((newsgroups (mail-fetch-field "newsgroups")))
75 (message-remove-header "to")
76 (message-remove-header "cc")
77 (goto-char (point-min))
78 (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
79 "@" gateway "\n")))
80
81 (defun nngateway-mail2news-header-transformation (gateway)
82 "Transform the headers for sending to a mail2news gateway."
83 (message-remove-header "to")
84 (message-remove-header "cc")
85 (goto-char (point-min))
86 (insert "To: " gateway "\n"))
87
88 (nnoo-define-skeleton nngateway)
89
90 (provide 'nngateway)
91
92 ;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc
93 ;;; nngateway.el ends here