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

   1 ;;; nndraft.el --- draft article access for Gnus
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   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 (require 'nnheader)
  31 (require 'nnmail)
  32 (require 'gnus-start)
  33 (require 'nnmh)
  34 (require 'nnoo)
  35 (require 'mm-util)
  36 (eval-when-compile (require 'cl))
  37
  38 (nnoo-declare nndraft
  39   nnmh)
  40
  41 (defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")
  42   "Where nndraft will store its files."
  43   nnmh-directory)
  44
  45 \f
  46
  47 (defvoo nndraft-current-group "" nil nnmh-current-group)
  48 (defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail)
  49 (defvoo nndraft-current-directory nil nil nnmh-current-directory)
  50
  51 (defconst nndraft-version "nndraft 1.0")
  52 (defvoo nndraft-status-string "" nil nnmh-status-string)
  53
  54 \f
  55
  56 ;;; Interface functions.
  57
  58 (nnoo-define-basics nndraft)
  59
  60 (deffoo nndraft-open-server (server &optional defs)
  61   (nnoo-change-server 'nndraft server defs)
  62   (cond
  63    ((not (file-exists-p nndraft-directory))
  64     (nndraft-close-server)
  65     (nnheader-report 'nndraft "No such file or directory: %s"
  66                      nndraft-directory))
  67    ((not (file-directory-p (file-truename nndraft-directory)))
  68     (nndraft-close-server)
  69     (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory))
  70    (t
  71     (nnheader-report 'nndraft "Opened server %s using directory %s"
  72                      server nndraft-directory)
  73     t)))
  74
  75 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
  76   (nndraft-possibly-change-group group)
  77   (save-excursion
  78     (set-buffer nntp-server-buffer)
  79     (erase-buffer)
  80     (let* (article)
  81       ;; We don't support fetching by Message-ID.
  82       (if (stringp (car articles))
  83           'headers
  84         (while articles
  85           (narrow-to-region (point) (point))
  86           (when (nndraft-request-article
  87                  (setq article (pop articles)) group server (current-buffer))
  88             (goto-char (point-min))
  89             (if (search-forward "\n\n" nil t)
  90                 (forward-line -1)
  91               (goto-char (point-max)))
  92             (delete-region