comparison lisp/gnus/nndraft.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; nndraft.el --- draft article access for Gnus
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
;;        Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news

;; This file is part of GNU Emacs.

;; 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 'nnmail)
(require 'gnus-start)
(require 'nnmh)
(require 'nnoo)
(require 'mm-util)
(eval-when-compile
  (require 'cl)
  ;; This is just to shut up the byte-compiler.
  (fset 'nndraft-request-group 'ignore))

(nnoo-declare nndraft
  nnmh)

(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")

	   (newest (if (file-newer-than-file-p file auto) file auto))
	   (nntp-server-buffer (or buffer nntp-server-buffer)))
      (when (and (file-exists-p newest)
		 (let ((nnmail-file-coding-system
			(if (file-newer-than-file-p file auto)
			    (if (equal group "drafts")
				message-draft-coding-system
			      mm-text-coding-system)
			  mm-auto-save-coding-system)))
		   (nnmail-find-file newest)))
	(save-excursion
	  (set-buffer nntp-server-buffer)
	  (goto-char (point-min))
	  ;; If there's a mail header separator in this file,
	  ;; we remove it.
	  (when (re-search-forward
		 (concat "^" mail-header-separator "$") nil t)
	    (replace-match "" t t)))
	t))))

(deffoo nndraft-request-restore-buffer (article &optional group server)
  "Request a new buffer that is restored to the state of ARTICLE."
  (nndraft-possibly-change-group group)
  (when (nndraft-request-article article group server (current-buffer))
    (message-remove-header "xref")
    (message-remove-header "lines")
    t))

(deffoo nndraft-request-update-info (group info &optional server)
  (nndraft-possibly-change-group group)
  (gnus-info-set-read

	      (if (assq 'unsend marks)
		  (list (assq 'unsend marks))
		nil))))
  t)

(deffoo nndraft-request-associate-buffer (group)
  "Associate the current buffer with some article in the draft group."
  (nndraft-open-server "")
  (nndraft-request-group group)
  (nndraft-possibly-change-group group)

		     group (nnoo-current-server 'nndraft) t 'noinsert)
	    file (nndraft-article-filename article)))
    (setq buffer-file-name (expand-file-name file)
	  buffer-auto-save-file-name (make-auto-save-file-name))
    (clear-visited-file-modtime)
    article))

(deffoo nndraft-request-expire-articles (articles group &optional server force)
  (nndraft-possibly-change-group group)
  (let* ((nnmh-allow-delete-final t)
	 (res (nnoo-parent-function 'nndraft

			  (list group server last noinsert))))

(deffoo nndraft-request-replace-article (article group buffer)
  (nndraft-possibly-change-group group)
  (let ((nnmail-file-coding-system
	 (if (equal group "drafts")
	     mm-auto-save-coding-system
	   mm-text-coding-system)))
    (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
			  (list article group buffer))))

(deffoo nndraft-request-create-group (group &optional server args)

(defun nndraft-articles ()
  "Return the list of messages in the group."
  (gnus-make-directory nndraft-current-directory)
  (sort
   (mapcar 'string-to-int
	   (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
   '<))

(nnoo-import nndraft
  (nnmh
   nnmh-retrieve-headers
   nnmh-request-group
   nnmh-close-group
   nnmh-request-list
   nnmh-request-newsgroups
   nnmh-request-move-article))

(provide 'nndraft)

;;; nndraft.el ends here

88155:d7ddb3e565de

;;; nndraft.el --- draft article access for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
;;   2004, 2005 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news

;; This file is part of GNU Emacs.

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(require 'nnmail)
(require 'gnus-start)
(require 'nnmh)
(require 'nnoo)
(require 'mm-util)
(eval-when-compile (require 'cl))

(nnoo-declare nndraft
  nnmh)

(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")

	   (newest (if (file-newer-than-file-p file auto) file auto))
	   (nntp-server-buffer (or buffer nntp-server-buffer)))
      (when (and (file-exists-p newest)
		 (let ((nnmail-file-coding-system
			(if (file-newer-than-file-p file auto)
			    (if (member group '("drafts" "delayed"))
				message-draft-coding-system
			      mm-text-coding-system)
			  mm-auto-save-coding-system)))
		   (nnmail-find-file newest)))
	(save-excursion
	  (set-buffer nntp-server-buffer)
	  (goto-char (point-min))
	  ;; If there's a mail header separator in this file,
	  ;; we remove it.
	  (when (re-search-forward
		 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
	    (replace-match "" t t)))
	t))))

(deffoo nndraft-request-restore-buffer (article &optional group server)
  "Request a new buffer that is restored to the state of ARTICLE."
  (nndraft-possibly-change-group group)
  (when (nndraft-request-article article group server (current-buffer))
    (message-remove-header "xref")
    (message-remove-header "lines")
    ;; Articles in nndraft:queue are considered as sent messages.  The
    ;; Date field should be the time when they are sent.
    ;;(message-remove-header "date")
    t))

(deffoo nndraft-request-update-info (group info &optional server)
  (nndraft-possibly-change-group group)
  (gnus-info-set-read

	      (if (assq 'unsend marks)
		  (list (assq 'unsend marks))
		nil))))
  t)

(defun nndraft-generate-headers ()
  (save-excursion
    (message-generate-headers
     (message-headers-to-generate
      message-required-headers message-draft-headers nil))))

(deffoo nndraft-request-associate-buffer (group)
  "Associate the current buffer with some article in the draft group."
  (nndraft-open-server "")
  (nndraft-request-group group)
  (nndraft-possibly-change-group group)

		     group (nnoo-current-server 'nndraft) t 'noinsert)
	    file (nndraft-article-filename article)))
    (setq buffer-file-name (expand-file-name file)
	  buffer-auto-save-file-name (make-auto-save-file-name))
    (clear-visited-file-modtime)
    (let ((hook (if (boundp 'write-contents-functions)
		    'write-contents-functions
		  'write-contents-hooks)))
      (gnus-make-local-hook hook)
      (add-hook hook 'nndraft-generate-headers nil t))
    article))

(deffoo nndraft-request-group (group &optional server dont-check)
  (nndraft-possibly-change-group group)
  (unless dont-check
    (let* ((pathname (nnmail-group-pathname group nndraft-directory))
	   (file-name-coding-system nnmail-pathname-coding-system)
	   dir file)
      (nnheader-re-read-dir pathname)
      (setq dir (mapcar (lambda (name) (string-to-number (substring name 1)))
			(ignore-errors (directory-files
					pathname nil "^#[0-9]+#$" t))))
      (dolist (n dir)
	(unless (file-exists-p
		 (setq file (expand-file-name (int-to-string n) pathname)))
	  (rename-file (nndraft-auto-save-file-name file) file)))))
  (nnoo-parent-function 'nndraft
			'nnmh-request-group
			(list group server dont-check)))

(deffoo nndraft-request-move-article (article group server
					      accept-form &optional last)
  (nndraft-possibly-change-group group)
  (let ((buf (get-buffer-create " *nndraft move*"))
	result)
    (and
     (nndraft-request-article article group server)
     (save-excursion
       (set-buffer buf)
       (erase-buffer)
       (insert-buffer-substring nntp-server-buffer)
       (setq result (eval accept-form))
       (kill-buffer (current-buffer))
       result)
     (null (nndraft-request-expire-articles (list article) group server 'force))
     result)))

(deffoo nndraft-request-expire-articles (articles group &optional server force)
  (nndraft-possibly-change-group group)
  (let* ((nnmh-allow-delete-final t)
	 (res (nnoo-parent-function 'nndraft

			  (list group server last noinsert))))

(deffoo nndraft-request-replace-article (article group buffer)
  (nndraft-possibly-change-group group)
  (let ((nnmail-file-coding-system
	 (if (member group '("drafts" "delayed"))
	     message-draft-coding-system
	   mm-text-coding-system)))
    (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
			  (list article group buffer))))

(deffoo nndraft-request-create-group (group &optional server args)

(defun nndraft-articles ()
  "Return the list of messages in the group."
  (gnus-make-directory nndraft-current-directory)
  (sort
   (mapcar 'string-to-number
	   (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
   '<))

(nnoo-import nndraft
  (nnmh
   nnmh-retrieve-headers
   nnmh-request-group
   nnmh-close-group
   nnmh-request-list
   nnmh-request-newsgroups))

(provide 'nndraft)

;;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa
;;; nndraft.el ends here