Initial revision

parent 6748645f
This diff is collapsed.
;;; gnus-draft.el --- draft message support for Gnus
;; Copyright (C) 1997,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'gnus)
(require 'gnus-sum)
(require 'message)
(require 'gnus-msg)
(require 'nndraft)
(require 'gnus-agent)
(eval-when-compile (require 'cl))
;;; Draft minor mode
(defvar gnus-draft-mode nil
"Minor mode for providing a draft summary buffers.")
(defvar gnus-draft-mode-map nil)
(unless gnus-draft-mode-map
(setq gnus-draft-mode-map (make-sparse-keymap))
(gnus-define-keys gnus-draft-mode-map
"Dt" gnus-draft-toggle-sending
"De" gnus-draft-edit-message
"Ds" gnus-draft-send-message
"DS" gnus-draft-send-all-messages))
(defun gnus-draft-make-menu-bar ()
(unless (boundp 'gnus-draft-menu)
(easy-menu-define
gnus-draft-menu gnus-draft-mode-map ""
'("Drafts"
["Toggle whether to send" gnus-draft-toggle-sending t]
["Edit" gnus-draft-edit-message t]
["Send selected message(s)" gnus-draft-send-message t]
["Send all messages" gnus-draft-send-all-messages t]
["Delete draft" gnus-summary-delete-article t]))))
(defun gnus-draft-mode (&optional arg)
"Minor mode for providing a draft summary buffers.
\\{gnus-draft-mode-map}"
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
(when (set (make-local-variable 'gnus-draft-mode)
(if (null arg) (not gnus-draft-mode)
(> (prefix-numeric-value arg) 0)))
;; Set up the menu.
(when (gnus-visual-p 'draft-menu 'menu)
(gnus-draft-make-menu-bar))
(gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
(gnus-run-hooks 'gnus-draft-mode-hook))))
;;; Commands
(defun gnus-draft-toggle-sending (article)
"Toggle whether to send an article or not."
(interactive (list (gnus-summary-article-number)))
(if (gnus-draft-article-sendable-p article)
(progn
(push article gnus-newsgroup-unsendable)
(gnus-summary-mark-article article gnus-unsendable-mark))
(setq gnus-newsgroup-unsendable
(delq article gnus-newsgroup-unsendable))
(gnus-summary-mark-article article gnus-unread-mark))
(gnus-summary-position-point))
(defun gnus-draft-edit-message ()
"Enter a mail/post buffer to edit and send the draft."
(interactive)
(let ((article (gnus-summary-article-number)))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-draft-setup article gnus-newsgroup-name)
(set-buffer-modified-p t)
(save-buffer)
(push
`((lambda ()
(when (gnus-buffer-exists-p ,gnus-summary-buffer)
(save-excursion
(set-buffer ,gnus-summary-buffer)
(gnus-cache-possibly-remove-article ,article nil nil nil t)))))
message-send-actions)))
(defun gnus-draft-send-message (&optional n)
"Send the current draft."
(interactive "P")
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-remove-process-mark article)
(unless (memq article gnus-newsgroup-unsendable)
(gnus-draft-send article gnus-newsgroup-name)
(gnus-summary-mark-article article gnus-canceled-mark)))))
(defun gnus-draft-send (article &optional group)
"Send message ARTICLE."
(gnus-draft-setup article (or group "nndraft:queue"))
(let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)
message-send-hook type method)
;; We read the meta-information that says how and where
;; this message is to be sent.
(save-restriction
(message-narrow-to-head)
(when (re-search-forward
(concat "^" (regexp-quote gnus-agent-meta-information-header) ":")
nil t)
(setq type (ignore-errors (read (current-buffer)))
method (ignore-errors (read (current-buffer))))
(message-remove-header gnus-agent-meta-information-header)))
;; Then we send it. If we have no meta-information, we just send
;; it and let Message figure out how.
(when (and (or (null method)
(gnus-server-opened method)
(gnus-open-server method))
(if type
(let ((message-this-is-news (eq type 'news))
(message-this-is-mail (eq type 'mail))
(gnus-post-method method)
(message-post-method method))
(message-send-and-exit))
(message-send-and-exit)))
(let ((gnus-verbose-backends nil))
(gnus-request-expire-articles
(list article) (or group "nndraft:queue") t)))))
(defun gnus-draft-send-all-messages ()
"Send all the sendable drafts."
(interactive)
(gnus-uu-mark-buffer)
(gnus-draft-send-message))
(defun gnus-group-send-drafts ()
"Send all sendable articles from the queue group."
(interactive)
(gnus-activate-group "nndraft:queue")
(save-excursion
(let ((articles (nndraft-articles))
(unsendable (gnus-uncompress-range
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
article)
(while (setq article (pop articles))
(unless (memq article unsendable)
(gnus-draft-send article))))))
;;; Utility functions
;;;!!!If this is byte-compiled, it fails miserably.
;;;!!!This is because `gnus-setup-message' uses uninterned symbols.
;;;!!!This has been fixed in recent versions of Emacs and XEmacs,
;;;!!!but for the time being, we'll just run this tiny function uncompiled.
(progn
(defun gnus-draft-setup (narticle group)
(gnus-setup-message 'forward
(let ((article narticle))
(message-mail)
(erase-buffer)
(if (not (gnus-request-restore-buffer article group))
(error "Couldn't restore the article")
;; Insert the separator.
(goto-char (point-min))
(search-forward "\n\n")
(forward-char -1)
(insert mail-header-separator)
(forward-line 1)
(message-set-auto-save-file-name))))))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."
(not (memq article gnus-newsgroup-unsendable)))
(provide 'gnus-draft)
;;; gnus-draft.el ends here
;;; nnagent.el --- offline backend for Gnus
;; Copyright (C) 1997,98 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'nnheader)
(require 'nnoo)
(eval-when-compile (require 'cl))
(require 'gnus-agent)
(require 'nnml)
(nnoo-declare nnagent
nnml)
(defconst nnagent-version "nnagent 1.0")
(defvoo nnagent-directory nil
"Internal variable."
nnml-directory)
(defvoo nnagent-active-file nil
"Internal variable."
nnml-active-file)
(defvoo nnagent-newsgroups-file nil
"Internal variable."
nnml-newsgroups-file)
(defvoo nnagent-get-new-mail nil
"Internal variable."
nnml-get-new-mail)
;;; Interface functions.
(nnoo-define-basics nnagent)
(deffoo nnagent-open-server (server &optional defs)
(setq defs
`((nnagent-directory ,(gnus-agent-directory))
(nnagent-active-file ,(gnus-agent-lib-file "active"))
(nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups"))
(nnagent-get-new-mail nil)))
(nnoo-change-server 'nnagent server defs)
(let ((dir (gnus-agent-directory))
err)
(cond
((not (condition-case arg
(file-exists-p dir)
(ftp-error (setq err (format "%s" arg)))))
(nnagent-close-server)
(nnheader-report
'nnagent (or err
(format "No such file or directory: %s" dir))))
((not (file-directory-p (file-truename dir)))
(nnagent-close-server)
(nnheader-report 'nnagent "Not a directory: %s" dir))
(t
(nnheader-report 'nnagent "Opened server %s using directory %s"
server dir)
t))))
(deffoo nnagent-retrieve-groups (groups &optional server)
(save-excursion
(cond
((file-exists-p (gnus-agent-lib-file "groups"))
(nnmail-find-file (gnus-agent-lib-file "groups"))
'groups)
((file-exists-p (gnus-agent-lib-file "active"))
(nnmail-find-file (gnus-agent-lib-file "active"))
'active)
(t nil))))
(defun nnagent-request-type (group article)
(unless (stringp article)
(let ((gnus-plugged t))
(if (not (gnus-check-backend-function
'request-type (car gnus-command-method)))
'unknown
(funcall (gnus-get-function gnus-command-method 'request-type)
(gnus-group-real-name group) article)))))
(deffoo nnagent-request-newgroups (date server)
nil)
(deffoo nnagent-request-update-info (group info &optional server)
nil)
(deffoo nnagent-request-post (&optional server)
(gnus-agent-insert-meta-information 'news gnus-command-method)
(gnus-request-accept-article "nndraft:queue"))
;; Use nnml functions for just about everything.
(nnoo-import nnagent
(nnml))
;;; Internal functions.
(provide 'nnagent)
;;; nnagent.el ends here
;;; nnlistserv.el --- retrieving articles via web mailing list archives
;; Copyright (C) 1997,98 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Note: You need to have `url' and `w3' installed for this
;; backend to work.
;;; Code:
(eval-when-compile (require 'cl))
(require 'nnoo)
(require 'nnweb)
(nnoo-declare nnlistserv
nnweb)
(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
"Where nnlistserv will save its files."
nnweb-directory)
(defvoo nnlistserv-name 'kk
"What search engine type is being used."
nnweb-type)
(defvoo nnlistserv-type-definition
'((kk
(article . nnlistserv-kk-wash-article)
(map . nnlistserv-kk-create-mapping)
(search . nnlistserv-kk-search)
(address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
(pages "fra160396" "fra160796" "fra061196" "fra160197"
"fra090997" "fra040797" "fra130397" "nye")
(index . "date.html")
(identifier . nnlistserv-kk-identity)))
"Type-definition alist."
nnweb-type-definition)
(defvoo nnlistserv-search nil
"Search string to feed to DejaNews."
nnweb-search)
(defvoo nnlistserv-ephemeral-p nil
"Whether this nnlistserv server is ephemeral."
nnweb-ephemeral-p)
;;; Internal variables
;;; Interface functions
(nnoo-define-basics nnlistserv)
(nnoo-import nnlistserv
(nnweb))
;;; Internal functions
;;;
;;; KK functions.
;;;
(defun nnlistserv-kk-create-mapping ()
"Perform the search and create an number-to-url alist."
(save-excursion
(set-buffer nnweb-buffer)
(let ((case-fold-search t)
(active (or (cadr (assoc nnweb-group nnweb-group-alist))
(cons 1 0)))
(pages (nnweb-definition 'pages))
map url page subject from )
(while (setq page (pop pages))
(erase-buffer)
(when (funcall (nnweb-definition 'search) page)
;; Go through all the article hits on this page.
(goto-char (point-min))
(nnweb-decode-entities)
(goto-char (point-min))
(while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
(setq url (match-string 1)
subject (match-string 2)
from (match-string 3))
(setq url (concat (format (nnweb-definition 'address) page) url))
(unless (nnweb-get-hashtb url)
(push
(list
(incf (cdr active))
(make-full-mail-header
(cdr active) subject from ""
(concat "<" (nnweb-identifier url) "@kk>")
nil 0 0 url))
map)
(nnweb-set-hashtb (cadar map) (car map))
(nnheader-message 5 "%s %s %s" (cdr active) (point) pages)
))))
;; Return the articles in the right order.
(setq nnweb-articles
(sort (nconc nnweb-articles map) 'car-less-than-car)))))
(defun nnlistserv-kk-wash-article ()
(let ((case-fold-search t)
(headers '(sent name email subject id))
sent name email subject id)
(nnweb-decode-entities)
(while headers
(goto-char (point-min))
(re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers) nil t))
(set (pop headers) (match-string 1)))
(goto-char (point-min))
(search-forward "<!-- body" nil t)
(delete-region (point-min) (progn (forward-line 1) (point)))
(goto-char (point-max))
(search-backward "<!-- body" nil t)
(delete-region (point-max) (progn (beginning-of-line) (point)))
(nnweb-remove-markup)
(goto-char (point-min))
(insert (format "From: %s <%s>\n" name email)
(format "Subject: %s\n" subject)
(format "Message-ID: %s\n" id)
(format "Date: %s\n\n" sent))))
(defun nnlistserv-kk-search (search)
(url-insert-file-contents
(concat (format (nnweb-definition 'address) search)
(nnweb-definition 'index)))
t)
(defun nnlistserv-kk-identity (url)
"Return an unique identifier based on URL."
url)
(provide 'nnlistserv)
;;; nnlistserv.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment