mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-29 19:48:19 +00:00
4a05f85f5a
* lisp/gnus/gnus-agent.el, lisp/gnus/gnus-art.el: * lisp/gnus/gnus-async.el, lisp/gnus/gnus-cache.el: * lisp/gnus/gnus-demon.el, lisp/gnus/gnus-group.el: * lisp/gnus/gnus-icalendar.el, lisp/gnus/gnus-logic.el: * lisp/gnus/gnus-msg.el, lisp/gnus/gnus-picon.el: * lisp/gnus/gnus-registry.el, lisp/gnus/gnus-salt.el: * lisp/gnus/gnus-score.el, lisp/gnus/gnus-spec.el: * lisp/gnus/gnus-srvr.el, lisp/gnus/gnus-start.el: * lisp/gnus/gnus-sum.el, lisp/gnus/gnus-topic.el: * lisp/gnus/gnus-util.el, lisp/gnus/gnus-uu.el, lisp/gnus/gnus-win.el: * lisp/gnus/mail-source.el, lisp/gnus/mm-decode.el: * lisp/gnus/mm-encode.el, lisp/gnus/mm-url.el, lisp/gnus/mm-view.el: * lisp/gnus/mml-smime.el, lisp/gnus/mml.el, lisp/gnus/mml2015.el: * lisp/gnus/nnbabyl.el, lisp/gnus/nndoc.el, lisp/gnus/nneething.el: * lisp/gnus/nnheader.el, lisp/gnus/nnimap.el, lisp/gnus/nnmail.el: * lisp/gnus/nnmaildir.el, lisp/gnus/nnoo.el, lisp/gnus/nnrss.el: * lisp/gnus/nnspool.el, lisp/gnus/nntp.el, lisp/gnus/nnvirtual.el: * lisp/gnus/nnweb.el, lisp/gnus/spam.el: Replace cl with cl-lib. * lisp/gnus/canlock.el, lisp/gnus/gnus-bcklg.el: * lisp/gnus/gnus-cite.el, lisp/gnus/gnus-cloud.el: * lisp/gnus/gnus-draft.el, lisp/gnus/gnus-dup.el: * lisp/gnus/gnus-fun.el, lisp/gnus/gnus-html.el: * lisp/gnus/gnus-int.el, lisp/gnus/gnus-kill.el, lisp/gnus/gnus-ml.el: * lisp/gnus/gnus-mlspl.el, lisp/gnus/gnus-range.el: * lisp/gnus/gnus-undo.el, lisp/gnus/gnus-vm.el: * lisp/gnus/mm-partial.el, lisp/gnus/mm-uu.el, lisp/gnus/mml1991.el: * lisp/gnus/nnagent.el, lisp/gnus/nndiary.el, lisp/gnus/nndir.el: * lisp/gnus/nndraft.el, lisp/gnus/nnfolder.el, lisp/gnus/nngateway.el: * lisp/gnus/nnmairix.el, lisp/gnus/nnmbox.el, lisp/gnus/nnmh.el: * lisp/gnus/nnml.el, lisp/gnus/score-mode.el, lisp/gnus/smiley.el: No need for cl.
91 lines
2.8 KiB
EmacsLisp
91 lines
2.8 KiB
EmacsLisp
;;; nngateway.el --- posting news via mail gateways
|
|
|
|
;; Copyright (C) 1996-2018 Free Software Foundation, Inc.
|
|
|
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
;; Keywords: news, mail
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; Code:
|
|
|
|
(require 'nnoo)
|
|
(require 'message)
|
|
|
|
(nnoo-declare nngateway)
|
|
|
|
(defvoo nngateway-address nil
|
|
"Address of the mail-to-news gateway.")
|
|
|
|
(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
|
|
"Function to be called to rewrite the news headers into mail headers.
|
|
It is called narrowed to the headers to be transformed with one
|
|
parameter -- the gateway address.")
|
|
|
|
;;; Interface functions
|
|
|
|
(nnoo-define-basics nngateway)
|
|
|
|
(deffoo nngateway-open-server (server &optional defs)
|
|
(if (nngateway-server-opened server)
|
|
t
|
|
(unless (assq 'nngateway-address defs)
|
|
(setq defs (append defs (list (list 'nngateway-address server)))))
|
|
(nnoo-change-server 'nngateway server defs)))
|
|
|
|
(deffoo nngateway-request-post (&optional server)
|
|
(when (or (nngateway-server-opened server)
|
|
(nngateway-open-server server))
|
|
;; Rewrite the header.
|
|
(let ((buf (current-buffer)))
|
|
(with-temp-buffer
|
|
(insert-buffer-substring buf)
|
|
(message-narrow-to-head)
|
|
(funcall nngateway-header-transformation nngateway-address)
|
|
(goto-char (point-max))
|
|
(insert mail-header-separator "\n")
|
|
(widen)
|
|
(let (message-required-mail-headers)
|
|
(funcall (or message-send-mail-real-function
|
|
message-send-mail-function)))
|
|
t))))
|
|
|
|
;;; Internal functions
|
|
|
|
(defun nngateway-simple-header-transformation (gateway)
|
|
"Transform the headers to use GATEWAY."
|
|
(let ((newsgroups (mail-fetch-field "newsgroups")))
|
|
(message-remove-header "to")
|
|
(message-remove-header "cc")
|
|
(goto-char (point-min))
|
|
(insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
|
|
"@" gateway "\n")))
|
|
|
|
(defun nngateway-mail2news-header-transformation (gateway)
|
|
"Transform the headers for sending to a mail2news gateway."
|
|
(message-remove-header "to")
|
|
(message-remove-header "cc")
|
|
(goto-char (point-min))
|
|
(insert "To: " gateway "\n"))
|
|
|
|
(nnoo-define-skeleton nngateway)
|
|
|
|
(provide 'nngateway)
|
|
|
|
;;; nngateway.el ends here
|