Mercurial > emacs

comparison lisp/gnus/nnmh.el @ 31716:9968f55ad26e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update to emacs-21-branch of the Gnus CVS repository.
author Gerd Moellmann <gerd@gnu.org>
date Tue, 19 Sep 2000 13:37:09 +0000
parents 15fc6acbae7a
children 47d8bf1dec03
comparison
equal deleted inserted replaced
31715:7c896543d225 31716:9968f55ad26e
1 ;;; nnmh.el --- mhspool access for Gnus 1 ;;; nnmh.el --- mhspool access for Gnus
2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. 2
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
4 ;; Free Software Foundation, Inc.
3 5
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail 8 ;; Keywords: news, mail
7 9
46 48
47 (defvoo nnmh-prepare-save-mail-hook nil 49 (defvoo nnmh-prepare-save-mail-hook nil
48 "*Hook run narrowed to an article before saving.") 50 "*Hook run narrowed to an article before saving.")
49 51
50 (defvoo nnmh-be-safe nil 52 (defvoo nnmh-be-safe nil
51 "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") 53 "*If non-nil, nnmh will check all articles to make sure whether they are new or not.
54 Go through the .nnmh-articles file and compare with the actual
55 articles in this folder. The articles that are \"new\" will be marked
56 as unread by Gnus.")
52 57
53 58
54 59
55 (defconst nnmh-version "nnmh 1.0" 60 (defconst nnmh-version "nnmh 1.0"
56 "nnmh version.") 61 "nnmh version.")
58 (defvoo nnmh-current-directory nil 63 (defvoo nnmh-current-directory nil
59 "Current news group directory.") 64 "Current news group directory.")
60 65
61 (defvoo nnmh-status-string "") 66 (defvoo nnmh-status-string "")
62 (defvoo nnmh-group-alist nil) 67 (defvoo nnmh-group-alist nil)
63 (defvoo nnmh-allow-delete-final nil) 68 ;; Don't even think about setting this variable. It does not exist.
69 ;; Forget about it. Uh-huh. Nope. Nobody here. It's only bound
70 ;; dynamically by certain functions in nndraft.
71 (defvar nnmh-allow-delete-final nil)
64 72
65 73
66 74
67 ;;; Interface functions. 75 ;;; Interface functions.
68 76
75 (let* ((file nil) 83 (let* ((file nil)
76 (number (length articles)) 84 (number (length articles))
77 (large (and (numberp nnmail-large-newsgroup) 85 (large (and (numberp nnmail-large-newsgroup)
78 (> number nnmail-large-newsgroup))) 86 (> number nnmail-large-newsgroup)))
79 (count 0) 87 (count 0)
80 (file-name-coding-system 'binary) 88 (file-name-coding-system nnmail-pathname-coding-system)
81 (pathname-coding-system 'binary)
82 beg article) 89 beg article)
83 (nnmh-possibly-change-directory newsgroup server) 90 (nnmh-possibly-change-directory newsgroup server)
84 ;; We don't support fetching by Message-ID. 91 ;; We don't support fetching by Message-ID.
85 (if (stringp (car articles)) 92 (if (stringp (car articles))
86 'headers 93 'headers
104 (setq count (1+ count)) 111 (setq count (1+ count))
105 112
106 (and large 113 (and large
107 (zerop (% count 20)) 114 (zerop (% count 20))
108 (nnheader-message 5 "nnmh: Receiving headers... %d%%" 115 (nnheader-message 5 "nnmh: Receiving headers... %d%%"
109 (/ (* count 100) number)))) 116 (/ (* count 100) number))))
110 117
111 (when large 118 (when large
112 (nnheader-message 5 "nnmh: Receiving headers...done")) 119 (nnheader-message 5 "nnmh: Receiving headers...done"))
113 120
114 (nnheader-fold-continuation-lines) 121 (nnheader-fold-continuation-lines)
135 (deffoo nnmh-request-article (id &optional newsgroup server buffer) 142 (deffoo nnmh-request-article (id &optional newsgroup server buffer)
136 (nnmh-possibly-change-directory newsgroup server) 143 (nnmh-possibly-change-directory newsgroup server)
137 (let ((file (if (stringp id) 144 (let ((file (if (stringp id)
138 nil 145 nil
139 (concat nnmh-current-directory (int-to-string id)))) 146 (concat nnmh-current-directory (int-to-string id))))
140 (pathname-coding-system 'binary) 147 (file-name-coding-system nnmail-pathname-coding-system)
141 (file-name-coding-system 'binary)
142 (nntp-server-buffer (or buffer nntp-server-buffer))) 148 (nntp-server-buffer (or buffer nntp-server-buffer)))
143 (and (stringp file) 149 (and (stringp file)
144 (file-exists-p file) 150 (file-exists-p file)
145 (not (file-directory-p file)) 151 (not (file-directory-p file))
146 (save-excursion (nnmail-find-file file)) 152 (save-excursion (nnmail-find-file file))
148 154
149 (deffoo nnmh-request-group (group &optional server dont-check) 155 (deffoo nnmh-request-group (group &optional server dont-check)
150 (nnheader-init-server-buffer) 156 (nnheader-init-server-buffer)
151 (nnmh-possibly-change-directory group server) 157 (nnmh-possibly-change-directory group server)
152 (let ((pathname (nnmail-group-pathname group nnmh-directory)) 158 (let ((pathname (nnmail-group-pathname group nnmh-directory))
153 (pathname-coding-system 'binary) 159 (file-name-coding-system nnmail-pathname-coding-system)
154 (file-name-coding-system 'binary)
155 dir) 160 dir)
156 (cond 161 (cond
157 ((not (file-directory-p pathname)) 162 ((not (file-directory-p pathname))
158 (nnheader-report 163 (nnheader-report
159 'nnmh "Can't select group (no such directory): %s" group)) 164 'nnmh "Can't select group (no such directory): %s" group))
172 (setq dir 177 (setq dir
173 (sort 178 (sort
174 (mapcar (lambda (name) (string-to-int name)) 179 (mapcar (lambda (name) (string-to-int name))
175 (directory-files pathname nil "^[0-9]+$" t)) 180 (directory-files pathname nil "^[0-9]+$" t))
176 '<)) 181 '<))
177 (cond 182 (cond
178 (dir 183 (dir
179 (nnheader-report 'nnmh "Selected group %s" group) 184 (setq nnmh-group-alist
180 (nnheader-insert 185 (delq (assoc group nnmh-group-alist) nnmh-group-alist))
181 "211 %d %d %d %s\n" (length dir) (car dir) 186 (push (list group (cons (car dir) (car (last dir))))
182 (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) 187 nnmh-group-alist)
183 group)) 188 (nnheader-report 'nnmh "Selected group %s" group)
184 (t 189 (nnheader-insert
185 (nnheader-report 'nnmh "Empty group %s" group) 190 "211 %d %d %d %s\n" (length dir) (car dir)
186 (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) 191 (car (last dir)) group))
192 (t
193 (nnheader-report 'nnmh "Empty group %s" group)
194 (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
187 195
188 (deffoo nnmh-request-scan (&optional group server) 196 (deffoo nnmh-request-scan (&optional group server)
189 (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) 197 (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
190 198
191 (deffoo nnmh-request-list (&optional server dir) 199 (deffoo nnmh-request-list (&optional server dir)
192 (nnheader-insert "") 200 (nnheader-insert "")
193 (nnmh-possibly-change-directory nil server) 201 (nnmh-possibly-change-directory nil server)
194 (let* ((pathname-coding-system 'binary) 202 (let ((file-name-coding-system nnmail-pathname-coding-system)
195 (file-name-coding-system 'binary) 203 (nnmh-toplev
196 (nnmh-toplev 204 (file-truename (or dir (file-name-as-directory nnmh-directory)))))
197 (file-truename (or dir (file-name-as-directory nnmh-directory)))))
198 (nnmh-request-list-1 nnmh-toplev)) 205 (nnmh-request-list-1 nnmh-toplev))
199 (setq nnmh-group-alist (nnmail-get-active)) 206 (setq nnmh-group-alist (nnmail-get-active))
200 t) 207 t)
201 208
202 (defvar nnmh-toplev) 209 (defvar nnmh-toplev)
231 (regexp-quote 238 (regexp-quote
232 (file-truename (file-name-as-directory 239 (file-truename (file-name-as-directory
233 (expand-file-name nnmh-toplev)))) 240 (expand-file-name nnmh-toplev))))
234 dir) 241 dir)
235 (nnheader-replace-chars-in-string 242 (nnheader-replace-chars-in-string
236 (gnus-decode-coding-string (substring dir (match-end 0)) 243 (mm-decode-coding-string (substring dir (match-end 0))
237 nnmail-pathname-coding-system) 244 nnmail-pathname-coding-system)
238 ?/ ?.)) 245 ?/ ?.))
239 (apply 'max files) 246 (apply 'max files)
240 (apply 'min files))))))) 247 (apply 'min files)))))))
241 t) 248 t)
242 249
273 280
274 (deffoo nnmh-close-group (group &optional server) 281 (deffoo nnmh-close-group (group &optional server)
275 t) 282 t)
276 283
277 (deffoo nnmh-request-move-article 284 (deffoo nnmh-request-move-article
278 (article group server accept-form &optional last) 285 (article group server accept-form &optional last)
279 (let ((buf (get-buffer-create " *nnmh move*")) 286 (let ((buf (get-buffer-create " *nnmh move*"))
280 result) 287 result)
281 (and 288 (and
282 (nnmh-deletable-article-p group article) 289 (nnmh-deletable-article-p group article)
283 (nnmh-request-article article group server) 290 (nnmh-request-article article group server)
403 (when (and server 410 (when (and server
404 (not (nnmh-server-opened server))) 411 (not (nnmh-server-opened server)))
405 (nnmh-open-server server)) 412 (nnmh-open-server server))
406 (when newsgroup 413 (when newsgroup
407 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)) 414 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))
408 (file-name-coding-system 'binary) 415 (file-name-coding-system nnmail-pathname-coding-system))
409 (pathname-coding-system 'binary))
410 (if (file-directory-p pathname) 416 (if (file-directory-p pathname)
411 (setq nnmh-current-directory pathname) 417 (setq nnmh-current-directory pathname)
412 (error "No such newsgroup: %s" newsgroup))))) 418 (error "No such newsgroup: %s" newsgroup)))))
413 419
414 (defun nnmh-possibly-create-directory (group) 420 (defun nnmh-possibly-create-directory (group)
453 459
454 (defun nnmh-active-number (group) 460 (defun nnmh-active-number (group)
455 "Compute the next article number in GROUP." 461 "Compute the next article number in GROUP."
456 (let ((active (cadr (assoc group nnmh-group-alist))) 462 (let ((active (cadr (assoc group nnmh-group-alist)))
457 (dir (nnmail-group-pathname group nnmh-directory)) 463 (dir (nnmail-group-pathname group nnmh-directory))
458 (file-name-coding-system 'binary) 464 (file-name-coding-system nnmail-pathname-coding-system)
459 (pathname-coding-system 'binary)) 465 file)
460 (unless active 466 (unless active
461 ;; The group wasn't known to nnmh, so we just create an active 467 ;; The group wasn't known to nnmh, so we just create an active
462 ;; entry for it. 468 ;; entry for it.
463 (setq active (cons 1 0)) 469 (setq active (cons 1 0))
464 (push (list group active) nnmh-group-alist) 470 (push (list group active) nnmh-group-alist)
472 (directory-files dir nil "^[0-9]+$")) 478 (directory-files dir nil "^[0-9]+$"))
473 '>))) 479 '>)))
474 (when files 480 (when files
475 (setcdr active (car files))))) 481 (setcdr active (car files)))))
476 (setcdr active (1+ (cdr active))) 482 (setcdr active (1+ (cdr active)))
477 (while (file-exists-p 483 (while (or
478 (concat (nnmail-group-pathname group nnmh-directory) 484 ;; See whether the file exists...
479 (int-to-string (cdr active)))) 485 (file-exists-p
486 (setq file (concat (nnmail-group-pathname group nnmh-directory)
487 (int-to-string (cdr active)))))
488 ;; ... or there is a buffer that will make that file exist
489 ;; in the future.
490 (get-file-buffer file))
491 ;; Skip past that file.
480 (setcdr active (1+ (cdr active)))) 492 (setcdr active (1+ (cdr active))))
481 (cdr active))) 493 (cdr active)))
482 494
483 (defun nnmh-update-gnus-unreads (group) 495 (defun nnmh-update-gnus-unreads (group)
484 ;; Go through the .nnmh-articles file and compare with the actual 496 ;; Go through the .nnmh-articles file and compare with the actual
537 (setq new (sort new '<)))) 549 (setq new (sort new '<))))
538 ;; Sort the article list with highest numbers first. 550 ;; Sort the article list with highest numbers first.
539 (setq articles (sort articles (lambda (art1 art2) 551 (setq articles (sort articles (lambda (art1 art2)
540 (> (car art1) (car art2))))) 552 (> (car art1) (car art2)))))
541 ;; Finally write this list back to the .nnmh-articles file. 553 ;; Finally write this list back to the .nnmh-articles file.
542 (nnheader-temp-write nnmh-file 554 (with-temp-file nnmh-file
543 (insert ";; Gnus article active file for " group "\n\n") 555 (insert ";; Gnus article active file for " group "\n\n")
544 (insert "(setq nnmh-newsgroup-articles '") 556 (insert "(setq nnmh-newsgroup-articles '")
545 (gnus-prin1 articles) 557 (gnus-prin1 articles)
546 (insert ")\n")))) 558 (insert ")\n"))))
547 559