annotate lisp/gnus/nnmh.el @ 47576:b31c8ab7336a

Sync with version 2.0.20. Lengthy ChangeLog follows: 2002-09-22 Kai Gro?ohann <[e-mail]> Version 2.0.20 released. 2002-09-20 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-completion-function-alist): Escape open paren in docstring. (tramp-user-regexp, tramp-host-regexp): Allow empty strings. (tramp-handle-insert-file-contents): Call tramp-message-for-buffer instead of tramp-message. (tramp-open-connection-rsh): Handle empty string as user name. (tramp-open-connection-su): Handle empty string as host name. Handle nil user name. (tramp-handle-file-local-copy, tramp-handle-write-region) (tramp-completion-handle-file-name-all-completions) (tramp-open-connection-telnet, tramp-open-connection-rsh) (tramp-open-connection-su, tramp-post-connection) (tramp-maybe-open-connection, tramp-method-out-of-band-p) (tramp-get-connection-function, tramp-get-remote-sh) (tramp-get-rsh-program, tramp-get-rsh-args) (tramp-get-rcp-program, tramp-get-rcp-args) (tramp-get-rcp-keep-date-arg, tramp-get-su-program) (tramp-get-su-args, tramp-get-telnet-program) (tramp-get-telnet-args): Use `tramp-find-method', perhaps require additional args USER, HOST. (tramp-action-password, tramp-open-connection-telnet) (tramp-open-connection-su, tramp-open-connection-multi) (tramp-method-out-of-band-p): `tramp-method-out-of-band-p' now takes USER and HOST arguments, to be able to use `tramp-find-method'. Update callers. (tramp-find-method): New function. 2002-09-20 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-handle-insert-directory): Handle "--dired" in SWITCHES (by removing it). 2002-09-18 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-file-name-handler): Add `file-remote-p' property. 2002-09-17 Kai Gro?ohann <[e-mail]> * net/tramp.el (top-level): Maybe autoload uudecode-decode-region. 2002-09-16 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-bug): Add tramp-methods. 2002-09-16 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-methods): Update docstring: tramp-encoding-command, tramp-decoding-command, tramp-encoding-function and tramp-decoding-function are not parameters anymore. (tramp-uuencode-region): Autoload it. 2002-09-13 Kai Gro?ohann <[e-mail]> Version 2.0.19 released. * net/tramp-uu.el: New file, implements uuencode in Lisp. * net/tramp.el (tramp-coding-commands): Use `tramp-uuencode-region' as local encoder for the uuencode based entries. 2002-09-13 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-handle-write-region): Wrong parens. 2002-09-13 Kai Gro?ohann <[e-mail]> Version 2.0.18 released. * net/tramp.el (tramp-perl-decode): Perl changes to accomodate older versions of Perl. Now tested with 5.004. Suggestion from Michael Albinus. 2002-09-12 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-find-inline-encoding): Call tramp-call-local-coding-command with nil for INPUT and OUTPUT. (tramp-call-local-coding-command): OUTPUT equals nil means to discard the output. INPUT equals nil means /dev/null. 2002-09-12 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-encoding-shell): Default to environment variable COMSPEC on Windows. (tramp-handle-write-region): More debugging output. (tramp-find-inline-encoding): Ditto. 2002-09-11 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-handle-file-name-all-completions): Define `result1'. (tramp-parse-hosts-group): Discard IPv6 entries. 2002-09-11 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-post-connection): Only send Perl mime-encode/decode implementations when using inline method. (tramp-handle-file-local-copy) (tramp-handle-write-region, tramp-post-connection) (tramp-coding-commands, tramp-find-inline-encoding): For the inline encodings, distinguish between local and remote commands, instead of between commands and functions. (The local commands can be functions, too.) If the local host is a Windows machine, we can't expect the same commands to work there as on the remote host. (tramp-call-local-coding-command): New function for calling local encoding and decoding commands. (tramp-set-remote-encoding, tramp-get-remote-encoding) (tramp-set-remote-decoding, tramp-get-remote-decoding) (tramp-set-local-encoding, tramp-get-local-encoding) (tramp-set-local-decoding, tramp-get-local-decoding): New functions. (tramp-get-encoding-command, tramp-set-encoding-command) (tramp-get-decoding-command, tramp-set-decoding-command) (tramp-get-encoding-function, tramp-set-encoding-function) (tramp-get-decoding-function, tramp-set-decoding-function): Old functions, removed. 2002-09-10 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Change command to invoke /bin/sh slightly to make it compatible with the `rc' shell. Suggested by Daniel Pittman. 2002-09-10 Michael Albinus <[e-mail]> * net/tramp.el (tramp-handle-write-region): Added missing `)'. Hope it's the right place. 2002-09-09 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Do "exec env PS1='$ ' /bin/sh" instead of just "exec /bin/sh" in order to get a sane shell prompt. If people have ${CWD}, say, in their shell prompt, then the default login shell might display something harmless, but the /bin/sh will display a dollar sign which confused the subsequent prompt recognition. (tramp-multi-action-password): More debugging output. (tramp-encoding-shell): Renamed from tramp-sh-program. More documentation. Default to cmd.exe on Windows NT. (tramp-encoding-command-switch): New variable. Use instead of hard-wired "-c" which is only good for /bin/sh. (tramp-encoding-reads-stdin): New variable. If t, commands are called like "/bin/sh -c COMMAND <INPUT", if nil, they are called like "/bin/sh -c COMMAND INPUT", ie the input file is the last argument. (tramp-multi-sh-program): Always default to tramp-encoding-shell. (tramp-handle-file-local-copy, tramp-handle-write-region): Respect tramp-encoding-shell and friends. (tramp-find-inline-encoding): Use new-style calls for checking if the local commands work. 2002-09-07 Michael Albinus <[e-mail]> * net/tramp.el (tramp-methods): Remove `tramp-completion-function' entries. They are handled now by `tramp-completion-function-alist'. (tramp-completion-function): Defvar removed. I've never used it. Hmm. (tramp-get-completion-function) (tramp-get-completion-rsh, tramp-get-completion-ssh) (tramp-get-completion-telnet, tramp-get-completion-su): Functions removed as well. Not necessary any longer due to extended customization means. (tramp-completion-function-alist): New defcustom. Holds all FUNCTION FILE pairs used for user and host name completion relevant for METHOD. (tramp-completion-function-alist-rsh) (tramp-completion-function-alist-ssh) (tramp-completion-function-alist-telnet) (tramp-completion-function-alist-su): Defconst for initializing `tramp-completion-function-alist'. Unfortunately, mainly UNIX-like values are known for me until now. Needs to be completed for at least VMS++ like operating systems. (tramp-set-completion-function) (tramp-get-completion-function): New functions for configuration of `tramp-completion-function-alist'. The old definition of `tramp-get-completion-function' has been discarded. (tramp-completion-handle-file-name-all-completions): Change function call for user/host completion according to definition in `tramp-completion-function-alist'. (tramp-parse-passwd): Added exception handling for "root", because `tramp-get-completion-su' (the previous place for this stuff) doesn't exist any longer. 2002-09-07 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-enter-password): Use `tramp-password-end-of-line' to terminate the line. (tramp-bug): Include new variable `tramp-password-end-of-line'. (tramp-password-end-of-line): New variable. People who use plink under Windows might have to issue "\r\n" after the password, but they need to send just "\n" after the other commands. So this variable was introduced to complement `tramp-rsh-end-of-line'. (tramp-wait-for-output, tramp-post-connection): Allow "\r" at end of line of the output delimiter. 2002-09-06 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-handle-file-local-copy, tramp-find-shell) (tramp-open-connection-setup-interactive-shell): Add some comments about Douglas Grey Stephen's suggestions to make Tramp work better with plink under Windows. I'm not sure what to think of them, but now I have a guinea pig to try it out on. Said guinea pig is having other problems, though... Also remove some commented-out code. 2002-09-06 Michael Albinus <[e-mail]> * net/tramp.el (tramp-get-completion-methods): Algorithm slightly tuned. (tramp-get-completion-user-host): Accept user names as they are if typed until "@". (tramp-completion-mode): Replace `last-input-char' by modern `last-input-event'. Check for `event-modifiers'. 2002-09-06 Kai Gro?ohann <[e-mail]> * net/tramp.el (file-expand-wildcards): Corrected check to see if advising is necessary. 2002-09-05 Michael Albinus <[e-mail]> * net/tramp.el (tramp-postfix-single-method-format) (tramp-postfix-multi-method-format) (tramp-postfix-multi-hop-format) (tramp-postfix-user-format): New format strings. (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-postfix-user-regexp) (tramp-make-multi-tramp-file-format) (tramp-make-tramp-file-name): Apply them. (tramp-completion-handle-file-name-all-completions): Fix for invoking ange-ftp in case of "/ftp:xxx" file names. 2002-09-04 Michael Albinus <[e-mail]> * net/tramp.el (tramp-prefix-format) (tramp-postfix-host-format): New format strings. (tramp-prefix-regexp, tramp-method-regexp) (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-user-regexp, tramp-postfix-user-regexp) (tramp-host-regexp, tramp-postfix-host-regexp) (tramp-path-regexp): New atomar regular expressions. If corresponding format strings exist, derived from them. (tramp-file-name-structure) (tramp-multi-file-name-structure) (tramp-multi-file-name-hop-structure) (tramp-make-multi-tramp-file-format) (tramp-completion-mode) (tramp-completion-dissect-file-name) (tramp-parse-rhosts-group) (tramp-parse-shosts-group) (tramp-parse-hosts-group) (tramp-parse-passwd-group): Apply these expressions. (tramp-file-name-structure-unified) (tramp-file-name-structure-separate) (tramp-make-tramp-file-format-unified) (tramp-make-tramp-file-format-separate) (tramp-make-tramp-file-format) (tramp-make-tramp-file-user-nil-format-unified) (tramp-make-tramp-file-user-nil-format-separate) (tramp-make-tramp-file-user-nil-format) (tramp-multi-file-name-structure-unified) (tramp-multi-file-name-structure-separate) (tramp-multi-file-name-hop-structure-unified) (tramp-multi-file-name-hop-structure-separate) (tramp-make-multi-tramp-file-format-unified) (tramp-make-multi-tramp-file-format-separate): Removed. (tramp-make-tramp-file-name): Allow partial tramp file names. Generate tramp file format on-the-fly depending on parameters. Apply atomar format strings resp expressions. (tramp-get-completion-methods) (tramp-get-completion-user-host): Apply `tramp-make-tramp-file-name'. (tramp-parse-hosts-group): Take all host names and IP addresses into account. (tramp-bug): Remove `tramp-make-tramp-file-format'. 2002-09-01 Michael Albinus <[e-mail]> * net/tramp.el (tramp-methods): Add `tramp-completion-function' for "su" and "sudo". (tramp-get-completion-telnet): Implement it. (tramp-parse-hosts) (tramp-parse-hosts-group) (tramp-get-completion-su) (tramp-parse-passwd) (tramp-parse-passwd-group): New functions. 2002-08-31 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-mode): Check for `last-input-char'. (tramp-completion-file-name-handler-alist): Add handler for `file-exists-p. (tramp-completion-handle-file-exists-p): New function. (tramp-completion-handle-file-name-completion): Simplified. (tramp-completion-dissect-file-name): Regexp's reorganised. (tramp-completion-handle-file-name-all-completions): Call completion-function only if `user' or `host' is given. (tramp-get-completion-user-host): New function. (tramp-get-completion-rsh) (tramp-get-completion-ssh): Apply it. 2002-08-29 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-file-name-handler-alist): Add handler for `expand-file-name'. (tramp-completion-handle-expand-file-name): New function. 2002-08-26 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-mode): New function. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-all-completions): Apply it. (tramp-methods): Remove double definition of `ssh1-old' and `ssh2-old'. (tramp-point-at-eol): New defalias. (tramp-parse-rhosts-group) (tramp-parse-shosts-group):: Apply it. 2002-08-25 Michael Albinus <[e-mail]> * net/tramp.el (tramp-get-completion-methods) (tramp-get-completion-rsh) (tramp-get-completion-ssh): Add "[" for Xemacs. (tramp-completion-file-name-regexp-separate): Expression adapted. (tramp-completion-file-name-handler-alist): Add handler for `file-name-directory' and `file-name-nondirectory'. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory) (tramp-completion-run-real-handler): New functions. (tramp-completion-file-name-handler) (tramp-completion-handle-file-name-all-completions): Apply `tramp-completion-run-real-handler'. (tramp-parse-rhosts) (tramp-parse-shosts): Use `with-temp-buffer'. `result? renamed to `res' (otherwise side effects in XEmacs). 2002-08-24 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist) (tramp-flatten-list) (tramp-completion-dissect-file-name) (tramp-get-completion-rsh) (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-get-completion-ssh): Doc string tuned. (tramp-methods): Doc string and custom type extended for `tramp-completion-function'. (tramp-completion-function): Variable added. Is it really used? Other variables like `tramp-completion-function' aren't used. (tramp-completion-file-name-handler-alist): Add handler for `file-name-completion'. (tramp-completion-handle-file-name-completion): New function. 2002-08-18 Michael Albinus <[e-mail]> * net/tramp.el (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-parse-shosts) (tramp-parse-shosts-group): New functions. 2002-08-17 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-dissect-file-name) (tramp-completion-dissect-file-name1): New functions. 2002-08-16 Michael Albinus <[e-mail]> * net/tramp.el (tramp-get-completion-function) (tramp-get-completion-rsh) (tramp-get-completion-ssh) (tramp-get-completion-telnet): New functions. (tramp-methods): Add `tramp-completion-function' for all methods. 2002-08-15 Michael Albinus <[e-mail]> * net/tramp.el (tramp-get-completion-methods): New function. (tramp-find-default-method): Allow host to be nil (like user). 2002-08-14 Michael Albinus <[e-mail]> * net/tramp.el (tramp-completion-file-name-regexp-unified) (tramp-completion-file-name-regexp-separate) (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist): New defcustoms. (tramp-completion-file-name-handler): New function. Add `tramp-completion-file-name-handler' to `file-name-handler-alist'. (tramp-run-real-handler): Add `tramp-completion-file-name-handler' to `inhibit-file-name-handlers'. (tramp-completion-handle-file-name-all-completions) (tramp-completion-handle-file-name-completion): New functions. 2002-08-12 Michael Albinus <[e-mail]> * net/tramp.el (tramp-invoke-ange-ftp): `tramp-disable-ange-ftp' must be called again after activating `ange-ftp'. (tramp-ange-ftp-file-name-p): Check for Xemacs. 2002-08-08 Michael Albinus <[e-mail]> * net/tramp.el (tramp-do-copy-or-rename-file): Don't pass KEEP-DATE to tramp-invoke-ange-ftp 'rename. (tramp-handle-write-region): Don't pass LOCKNAME and CONFIRM to tramp-invoke-ange-ftp 'write-region. (tramp-handle-set-file-modes): Change order of FILENAME and MODE passing to tramp-invoke-ange-ftp 'set-file-modes. (tramp-flatten-list): New function. Maybe this functionality does exist already elsewhere in the libraries. (tramp-invoke-ange-ftp): Apply `tramp-flatten-list' to parameter list in order to avoid nested lists, f.e. when invoked from `tramp-handle-dired-call-process'. 2002-09-05 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-chunksize): New kluge variable. (tramp-send-region): If tramp-chunksize is non-nil, send region in parts and sleep 0.1 seconds between chunks. 2002-09-03 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-handle-insert-directory): Use `insert-buffer-substring' instead of `insert-buffer', which is not supposed to be used from Lisp. Remember old point in a variable instead of using `mark'. Suggestion from Stefan Monnier. (tramp-unified-filenames): New variable. Use it in default value of other filename variables. (file-expand-wildcards): Don't advise unless "[" and "]" are used in the filename format. 2002-09-01 Kai Gro?ohann <[e-mail]> * net/tramp.el (tramp-methods): Remove duplicate definition of ssh1-old and ssh2-old.

;;; nnmh.el --- mhspool access for Gnus

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

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; 	Masanobu UMEDA <[e-mail]>
;; 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:

;; Based on nnspool.el by Masanobu UMEDA <[e-mail]>.
;; For an overview of what the interface functions do, please see the
;; Gnus sources.

;;; Code:

(require 'nnheader)
(require 'nnmail)
(require 'gnus-start)
(require 'nnoo)
(eval-when-compile (require 'cl))

(nnoo-declare nnmh)

(defvoo nnmh-directory message-directory
  "*Mail spool directory.")

(defvoo nnmh-get-new-mail t
  "*If non-nil, nnmh will check the incoming mail file and split the mail.")

(defvoo nnmh-prepare-save-mail-hook nil
  "*Hook run narrowed to an article before saving.")

(defvoo nnmh-be-safe nil
  "*If non-nil, nnmh will check all articles to make sure whether they are new or not.
Go through the .nnmh-articles file and compare with the actual
articles in this folder.  The articles that are \"new\" will be marked
as unread by Gnus.")



(defconst nnmh-version "nnmh 1.0"
  "nnmh version.")

(defvoo nnmh-current-directory nil
  "Current news group directory.")

(defvoo nnmh-status-string "")
(defvoo nnmh-group-alist nil)
;; Don't even think about setting this variable.  It does not exist.
;; Forget about it.  Uh-huh.  Nope.  Nobody here.  It's only bound
;; dynamically by certain functions in nndraft.
(defvar nnmh-allow-delete-final nil)



;;; Interface functions.

(nnoo-define-basics nnmh)

(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old)
  (save-excursion
    (set-buffer nntp-server-buffer)
    (erase-buffer)
    (let* ((file nil)
	   (number (length articles))
	   (large (and (numberp nnmail-large-newsgroup)
		       (> number nnmail-large-newsgroup)))
	   (count 0)
	   (file-name-coding-system nnmail-pathname-coding-system)
	   beg article)
      (nnmh-possibly-change-directory newsgroup server)
      ;; We don't support fetching by Message-ID.
      (if (stringp (car articles))
	  'headers
	(while articles
	  (when (and (file-exists-p
		      (setq file (concat (file-name-as-directory
					  nnmh-current-directory)
					 (int-to-string
					  (setq article (pop articles))))))
		     (not (file-directory-p file)))
	    (insert (format "221 %d Article retrieved.\n" article))
	    (setq beg (point))
	    (nnheader-insert-head file)
	    (goto-char beg)
	    (if (search-forward "\n\n" nil t)
		(forward-char -1)
	      (goto-char (point-max))
	      (insert "\n\n"))
	    (insert ".\n")
	    (delete-region (point) (point-max)))
	  (setq count (1+ count))

	  (and large
	       (zerop (% count 20))
	       (nnheader-message 5 "nnmh: Receiving headers... %d%%"
				 (/ (* count 100) number))))

	(when large
	  (nnheader-message 5 "nnmh: Receiving headers...done"))

	(nnheader-fold-continuation-lines)
	'headers))))

(deffoo nnmh-open-server (server &optional defs)
  (nnoo-change-server 'nnmh server defs)
  (when (not (file-exists-p nnmh-directory))
    (condition-case ()
	(make-directory nnmh-directory t)
      (error t)))
  (cond
   ((not (file-exists-p nnmh-directory))
    (nnmh-close-server)
    (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
   ((not (file-directory-p (file-truename nnmh-directory)))
    (nnmh-close-server)
    (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory))
   (t
    (nnheader-report 'nnmh "Opened server %s using directory %s"
		     server nnmh-directory)
    t)))

(deffoo nnmh-request-article (id &optional newsgroup server buffer)
  (nnmh-possibly-change-directory newsgroup server)
  (let ((file (if (stringp id)
		  nil
		(concat nnmh-current-directory (int-to-string id))))
	(file-name-coding-system nnmail-pathname-coding-system)
	(nntp-server-buffer (or buffer nntp-server-buffer)))
    (and (stringp file)
	 (file-exists-p file)
	 (not (file-directory-p file))
	 (save-excursion (nnmail-find-file file))
	 (string-to-int (file-name-nondirectory file)))))

(deffoo nnmh-request-group (group &optional server dont-check)
  (nnheader-init-server-buffer)
  (nnmh-possibly-change-directory group server)
  (let ((pathname (nnmail-group-pathname group nnmh-directory))
	(file-name-coding-system nnmail-pathname-coding-system)
	dir)
    (cond
     ((not (file-directory-p pathname))
      (nnheader-report
       'nnmh "Can't select group (no such directory): %s" group))
     (t
      (setq nnmh-current-directory pathname)
      (and nnmh-get-new-mail
	   nnmh-be-safe
	   (nnmh-update-gnus-unreads group))
      (cond
       (dont-check
	(nnheader-report 'nnmh "Selected group %s" group)
	t)
       (t
	;; Re-scan the directory if it's on a foreign system.
	(nnheader-re-read-dir pathname)
	(setq dir
	      (sort
	       (mapcar (lambda (name) (string-to-int name))
		       (directory-files pathname nil "^[0-9]+$" t))
	       '<))
	(cond
	 (dir
	  (setq nnmh-group-alist
		(delq (assoc group nnmh-group-alist) nnmh-group-alist))
	  (push (list group (cons (car dir) (car (last dir))))
		nnmh-group-alist)
	  (nnheader-report 'nnmh "Selected group %s" group)
	  (nnheader-insert
	   "211 %d %d %d %s\n" (length dir) (car dir)
	   (car (last dir)) group))
	 (t
	  (nnheader-report 'nnmh "Empty group %s" group)
	  (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))

(deffoo nnmh-request-scan (&optional group server)
  (nnmail-get-new-mail 'nnmh nil nnmh-directory group))

(deffoo nnmh-request-list (&optional server dir)
  (nnheader-insert "")
  (nnmh-possibly-change-directory nil server)
  (let ((file-name-coding-system nnmail-pathname-coding-system)
	(nnmh-toplev
	 (file-truename (or dir (file-name-as-directory nnmh-directory)))))
    (nnmh-request-list-1 nnmh-toplev))
  (setq nnmh-group-alist (nnmail-get-active))
  t)

(defvar nnmh-toplev)
(defun nnmh-request-list-1 (dir)
  (setq dir (expand-file-name dir))
  ;; Recurse down all directories.
  (let ((dirs (and (file-readable-p dir)
		   (> (nth 1 (file-attributes (file-chase-links dir))) 2)
		   (nnheader-directory-files dir t nil t)))
	rdir)
    ;; Recurse down directories.
    (while (setq rdir (pop dirs))
      (when (and (file-directory-p rdir)
		 (file-readable-p rdir)
		 (not (equal (file-truename rdir)
			     (file-truename dir))))
	(nnmh-request-list-1 rdir))))
  ;; For each directory, generate an active file line.
  (unless (string= (expand-file-name nnmh-toplev) dir)
    (let ((files (mapcar
		  (lambda (name) (string-to-int name))
		  (directory-files dir nil "^[0-9]+$" t))))
      (when files
	(save-excursion
	  (set-buffer nntp-server-buffer)
	  (goto-char (point-max))
	  (insert
	   (format
	    "%s %.0f %.0f y\n"
	    (progn
	      (string-match
	       (regexp-quote
		(file-truename (file-name-as-directory
				(expand-file-name nnmh-toplev))))
	       dir)
	      (nnheader-replace-chars-in-string
	       (mm-decode-coding-string (substring dir (match-end 0))
					nnmail-pathname-coding-system)
	       ?/ ?.))
	    (apply 'max files)
	    (apply 'min files)))))))
  t)

(deffoo nnmh-request-newgroups (date &optional server)
  (nnmh-request-list server))

(deffoo nnmh-request-expire-articles (articles newsgroup
					       &optional server force)
  (nnmh-possibly-change-directory newsgroup server)
  (let* ((is-old t)
	 article rest mod-time)
    (nnheader-init-server-buffer)

    (while (and articles is-old)
      (setq article (concat nnmh-current-directory
			    (int-to-string (car articles))))
      (when (setq mod-time (nth 5 (file-attributes article)))
	(if (and (nnmh-deletable-article-p newsgroup (car articles))
		 (setq is-old
		       (nnmail-expired-article-p newsgroup mod-time force)))
	    (progn
	      ;; Allow a special target group. -- jcn
	      (unless (eq nnmail-expiry-target 'delete)
		(with-temp-buffer
		  (nnmh-request-article (car articles)
					newsgroup server (current-buffer))
		  (nnmail-expiry-target-group
		   nnmail-expiry-target newsgroup)))
	      (nnheader-message 5 "Deleting article %s in %s..."
				article newsgroup)
	      (condition-case ()
		  (funcall nnmail-delete-file-function article)
		(file-error
		 (nnheader-message 1 "Couldn't delete article %s in %s"
				   article newsgroup)
		 (push (car articles) rest))))
	  (push (car articles) rest)))
      (setq articles (cdr articles)))
    (nnheader-message 5 "")
    (nconc rest articles)))

(deffoo nnmh-close-group (group &optional server)
  t)

(deffoo nnmh-request-move-article
    (article group server accept-form &optional last)
  (let ((buf (get-buffer-create " *nnmh move*"))
	result)
    (and
     (nnmh-deletable-article-p group article)
     (nnmh-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)
     (progn
       (nnmh-possibly-change-directory group server)
       (condition-case ()
	   (funcall nnmail-delete-file-function
		    (concat nnmh-current-directory (int-to-string article)))
	 (file-error nil))))
    result))

(deffoo nnmh-request-accept-article (group &optional server last noinsert)
  (nnmh-possibly-change-directory group server)
  (nnmail-check-syntax)
  (when nnmail-cache-accepted-message-ids
    (nnmail-cache-insert (nnmail-fetch-field "message-id")))
  (nnheader-init-server-buffer)
  (prog1
      (if (stringp group)
	  (if noinsert
	      (nnmh-active-number group)
	    (car (nnmh-save-mail
		  (list (cons group (nnmh-active-number group)))
		  noinsert)))
	(let ((res (nnmail-article-group 'nnmh-active-number)))
	  (if (and (null res)
		   (yes-or-no-p "Moved to `junk' group; delete article? "))
	      'junk
	    (car (nnmh-save-mail res noinsert)))))
    (when (and last nnmail-cache-accepted-message-ids)
      (nnmail-cache-close))))

(deffoo nnmh-request-replace-article (article group buffer)
  (nnmh-possibly-change-directory group)
  (save-excursion
    (set-buffer buffer)
    (nnmh-possibly-create-directory group)
    (ignore-errors
      (nnmail-write-region
       (point-min) (point-max)
       (concat nnmh-current-directory (int-to-string article))
       nil (if (nnheader-be-verbose 5) nil 'nomesg))
      t)))

(deffoo nnmh-request-create-group (group &optional server args)
  (nnheader-init-server-buffer)
  (unless (assoc group nnmh-group-alist)
    (let (active)
      (push (list group (setq active (cons 1 0)))
	    nnmh-group-alist)
      (nnmh-possibly-create-directory group)
      (nnmh-possibly-change-directory group server)
      (let ((articles (mapcar
		       (lambda (file)
			 (string-to-int file))
		       (directory-files
			nnmh-current-directory nil "^[0-9]+$"))))
	(when articles
	  (setcar active (apply 'min articles))
	  (setcdr active (apply 'max articles))))))
  t)

(deffoo nnmh-request-delete-group (group &optional force server)
  (nnmh-possibly-change-directory group server)
  ;; Delete all articles in GROUP.
  (if (not force)
      ()				; Don't delete the articles.
    (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
      (while articles
	(when (file-writable-p (car articles))
	  (nnheader-message 5 "Deleting article %s in %s..."
			    (car articles) group)
	  (funcall nnmail-delete-file-function (car articles)))
	(setq articles (cdr articles))))
    ;; Try to delete the directory itself.
    (ignore-errors
      (delete-directory nnmh-current-directory)))
  ;; Remove the group from all structures.
  (setq nnmh-group-alist
	(delq (assoc group nnmh-group-alist) nnmh-group-alist)
	nnmh-current-directory nil)
  t)

(deffoo nnmh-request-rename-group (group new-name &optional server)
  (nnmh-possibly-change-directory group server)
  (let ((new-dir (nnmail-group-pathname new-name nnmh-directory))
	(old-dir (nnmail-group-pathname group nnmh-directory)))
    (when (ignore-errors
	    (make-directory new-dir t)
	    t)
      ;; We move the articles file by file instead of renaming
      ;; the directory -- there may be subgroups in this group.
      ;; One might be more clever, I guess.
      (let ((files (nnheader-article-to-file-alist old-dir)))
	(while files
	  (rename-file
	   (concat old-dir (cdar files))
	   (concat new-dir (cdar files)))
	  (pop files)))
      (when (<= (length (directory-files old-dir)) 2)
	(ignore-errors
	  (delete-directory old-dir)))
      ;; That went ok, so we change the internal structures.
      (let ((entry (assoc group nnmh-group-alist)))
	(when entry
	  (setcar entry new-name))
	(setq nnmh-current-directory nil)
	t))))

(nnoo-define-skeleton nnmh)


;;; Internal functions.

(defun nnmh-possibly-change-directory (newsgroup &optional server)
  (when (and server
	     (not (nnmh-server-opened server)))
    (nnmh-open-server server))
  (when newsgroup
    (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))
	  (file-name-coding-system nnmail-pathname-coding-system))
      (if (file-directory-p pathname)
	  (setq nnmh-current-directory pathname)
	(error "No such newsgroup: %s" newsgroup)))))

(defun nnmh-possibly-create-directory (group)
  (let (dir dirs)
    (setq dir (nnmail-group-pathname group nnmh-directory))
    (while (not (file-directory-p dir))
      (push dir dirs)
      (setq dir (file-name-directory (directory-file-name dir))))
    (while dirs
      (when (make-directory (directory-file-name (car dirs)))
	(error "Could not create directory %s" (car dirs)))
      (nnheader-message 5 "Creating mail directory %s" (car dirs))
      (setq dirs (cdr dirs)))))

(defun nnmh-save-mail (group-art &optional noinsert)
  "Called narrowed to an article."
  (unless noinsert
    (nnmail-insert-lines)
    (nnmail-insert-xref group-art))
  (run-hooks 'nnmail-prepare-save-mail-hook)
  (run-hooks 'nnmh-prepare-save-mail-hook)
  (goto-char (point-min))
  (while (looking-at "From ")
    (replace-match "X-From-Line: ")
    (forward-line 1))
  ;; We save the article in all the newsgroups it belongs in.
  (let ((ga group-art)
	first)
    (while ga
      (nnmh-possibly-create-directory (caar ga))
      (let ((file (concat (nnmail-group-pathname
			   (caar ga) nnmh-directory)
			  (int-to-string (cdar ga)))))
	(if first
	    ;; It was already saved, so we just make a hard link.
	    (funcall nnmail-crosspost-link-function first file t)
	  ;; Save the article.
	  (nnmail-write-region (point-min) (point-max) file nil nil)
	  (setq first file)))
      (setq ga (cdr ga))))
  group-art)

(defun nnmh-active-number (group)
  "Compute the next article number in GROUP."
  (let ((active (cadr (assoc group nnmh-group-alist)))
	(dir (nnmail-group-pathname group nnmh-directory))
	(file-name-coding-system nnmail-pathname-coding-system)
	file)
    (unless active
      ;; The group wasn't known to nnmh, so we just create an active
      ;; entry for it.
      (setq active (cons 1 0))
      (push (list group active) nnmh-group-alist)
      (unless (file-exists-p dir)
	(gnus-make-directory dir))
      ;; Find the highest number in the group.
      (let ((files (sort
		    (mapcar
		     (lambda (f)
		       (string-to-int f))
		     (directory-files dir nil "^[0-9]+$"))
		    '>)))
	(when files
	  (setcdr active (car files)))))
    (setcdr active (1+ (cdr active)))
    (while (or
	    ;; See whether the file exists...
	    (file-exists-p
	     (setq file (concat (nnmail-group-pathname group nnmh-directory)
				(int-to-string (cdr active)))))
	    ;; ... or there is a buffer that will make that file exist
	    ;; in the future.
	    (get-file-buffer file))
      ;; Skip past that file.
      (setcdr active (1+ (cdr active))))
    (cdr active)))

(defun nnmh-update-gnus-unreads (group)
  ;; Go through the .nnmh-articles file and compare with the actual
  ;; articles in this folder.  The articles that are "new" will be
  ;; marked as unread by Gnus.
  (let* ((dir nnmh-current-directory)
	 (files (sort (mapcar (function (lambda (name) (string-to-int name)))
			      (directory-files nnmh-current-directory
					       nil "^[0-9]+$" t))
		      '<))
	 (nnmh-file (concat dir ".nnmh-articles"))
	 new articles)
    ;; Load the .nnmh-articles file.
    (when (file-exists-p nnmh-file)
      (setq articles
	    (let (nnmh-newsgroup-articles)
	      (ignore-errors (load nnmh-file nil t t))
	      nnmh-newsgroup-articles)))
    ;; Add all new articles to the `new' list.
    (let ((art files))
      (while art
	(unless (assq (car art) articles)
	  (push (car art) new))
	(setq art (cdr art))))
    ;; Remove all deleted articles.
    (let ((art articles))
      (while art
	(unless (memq (caar art) files)
	  (setq articles (delq (car art) articles)))
	(setq art (cdr art))))
    ;; Check whether the articles really are the ones that Gnus thinks
    ;; they are by looking at the time-stamps.
    (let ((arts articles)
	  art)
      (while (setq art (pop arts))
	(when (not (equal
		    (nth 5 (file-attributes
			    (concat dir (int-to-string (car art)))))
		    (cdr art)))
	  (setq articles (delq art articles))
	  (push (car art) new))))
    ;; Go through all the new articles and add them, and their
    ;; time-stamps, to the list.
    (setq articles
	  (nconc articles
		 (mapcar
		  (lambda (art)
		    (cons art
			  (nth 5 (file-attributes
				  (concat dir (int-to-string art))))))
		  new)))
    ;; Make Gnus mark all new articles as unread.
    (when new
      (gnus-make-articles-unread
       (gnus-group-prefixed-name group (list 'nnmh ""))
       (setq new (sort new '<))))
    ;; Sort the article list with highest numbers first.
    (setq articles (sort articles (lambda (art1 art2)
				    (> (car art1) (car art2)))))
    ;; Finally write this list back to the .nnmh-articles file.
    (with-temp-file nnmh-file
      (insert ";; Gnus article active file for " group "\n\n")
      (insert "(setq nnmh-newsgroup-articles '")
      (gnus-prin1 articles)
      (insert ")\n"))))

(defun nnmh-deletable-article-p (group article)
  "Say whether ARTICLE in GROUP can be deleted."
  (let ((path (concat nnmh-current-directory (int-to-string article))))
    ;; Writable.
    (and (file-writable-p path)
	 (or
	  ;; We can never delete the last article in the group.
	  (not (eq (cdr (nth 1 (assoc group nnmh-group-alist)))
		   article))
	  ;; Well, we can.
	  nnmh-allow-delete-final))))

(provide 'nnmh)

;;; nnmh.el ends here