X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnspool.el;h=b845d15f1913abd5cbf7888c3fdb5b7936f5faf5;hb=b36b862ca27ad784cbad9cdb36e9d1a97b0c0b97;hp=2fbeee8f00465ed1ab63fac50b013b3fafb8f19d;hpb=c66544cbcf56f439e6fc8c07079c829e7e16d1e0;p=gnus diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 2fbeee8f0..b845d15f1 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,5 +1,5 @@ ;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -18,8 +18,9 @@ ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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: @@ -28,6 +29,7 @@ (require 'nnheader) (require 'nntp) (require 'timezone) +(eval-when-compile (require 'cl)) (defvar nnspool-inews-program news-inews-program "Program to post news. @@ -93,23 +95,23 @@ there.") (defvar nnspool-current-server nil) (defvar nnspool-server-alist nil) (defvar nnspool-server-variables - (list - (list 'nnspool-inews-program nnspool-inews-program) - (list 'nnspool-inews-switches nnspool-inews-switches) - (list 'nnspool-spool-directory nnspool-spool-directory) - (list 'nnspool-nov-directory nnspool-nov-directory) - (list 'nnspool-lib-dir nnspool-lib-dir) - (list 'nnspool-active-file nnspool-active-file) - (list 'nnspool-newsgroups-file nnspool-newsgroups-file) - (list 'nnspool-distributions-file nnspool-distributions-file) - (list 'nnspool-history-file nnspool-history-file) - (list 'nnspool-active-times-file nnspool-active-times-file) - (list 'nnspool-large-newsgroup nnspool-large-newsgroup) - (list 'nnspool-nov-is-evil nnspool-nov-is-evil) - (list 'nnspool-sift-nov-with-sed nnspool-sift-nov-with-sed) - '(nnspool-current-directory nil) - '(nnspool-current-group nil) - '(nnspool-status-string ""))) + `((nnspool-inews-program ,nnspool-inews-program) + (nnspool-inews-switches ,nnspool-inews-switches) + (nnspool-spool-directory ,nnspool-spool-directory) + (nnspool-nov-directory ,nnspool-nov-directory) + (nnspool-lib-dir ,nnspool-lib-dir) + (nnspool-active-file ,nnspool-active-file) + (nnspool-newsgroups-file ,nnspool-newsgroups-file) + (nnspool-distributions-file ,nnspool-distributions-file) + (nnspool-rejected-article-hook nil) + (nnspool-history-file ,nnspool-history-file) + (nnspool-active-times-file ,nnspool-active-times-file) + (nnspool-large-newsgroup ,nnspool-large-newsgroup) + (nnspool-nov-is-evil ,nnspool-nov-is-evil) + (nnspool-sift-nov-with-sed ,nnspool-sift-nov-with-sed) + (nnspool-current-directory nil) + (nnspool-current-group nil) + (nnspool-status-string ""))) ;;; Interface functions. @@ -162,27 +164,23 @@ there.") (message "nnspool: Receiving headers...done")) ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) + (nnheader-fold-continuation-lines) 'headers))))) (defun nnspool-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (equal server nnspool-current-server) - t - (if nnspool-current-server - (setq nnspool-server-alist - (cons (list nnspool-current-server - (nnheader-save-variables nnspool-server-variables)) - nnspool-server-alist))) - (let ((state (assoc server nnspool-server-alist))) - (if state - (progn - (nnheader-restore-variables (nth 1 state)) - (setq nnspool-server-alist (delq state nnspool-server-alist))) - (nnheader-set-init-variables nnspool-server-variables defs))) - (setq nnspool-current-server server))) + (nnheader-change-server 'nnspool server defs) + (cond + ((not (file-exists-p nnspool-spool-directory)) + (nnspool-close-server) + (nnheader-report 'nnspool "Spool directory doesn't exist: %s" + nnspool-spool-directory)) + ((not (file-directory-p (file-truename nnspool-spool-directory))) + (nnspool-close-server) + (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) + (t + (nnheader-report 'nnspool "Opened server %s using directory %s" + server nnspool-spool-directory) + t))) (defun nnspool-close-server (&optional server) (setq nnspool-current-server nil) @@ -219,61 +217,55 @@ there.") (defun nnspool-request-body (id &optional group server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory group) - (if (nnspool-request-article id) + (let ((res (nnspool-request-article id))) + (when res (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (delete-region (point-min) (point))) - t))) + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (point))) + res)))) (defun nnspool-request-head (id &optional group server) "Select article head by message ID (or number)." (nnspool-possibly-change-directory group) - (if (nnspool-request-article id) + (let ((res (nnspool-request-article id))) + (when res (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - t))) + (when (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))))) + res)) (defun nnspool-request-group (group &optional server dont-check) "Select news GROUP." (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) - (progn - (setq nnspool-status-string - "Invalid group name (no such directory)") - nil) + (nnheader-report + 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) - (setq nnspool-status-string "") - (if (not dont-check) + (nnheader-report 'nnspool "Selected group %s" group) + (if dont-check (progn - (setq dir (directory-files pathname nil "^[0-9]+$" t)) - ;; yes, completely empty spool directories *are* possible - ;; Fix by Sudish Joseph - (and dir - (setq dir - (sort - (mapcar - (function - (lambda (name) - (string-to-int name))) - dir) - '<))) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if dir - (insert - (format "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) - (car dir)) - group)) - (insert (format "211 0 0 0 %s\n" group)))))) - t))) + (nnheader-report 'nnspool "Selected group %s" group) + t) + ;; Yes, completely empty spool directories *are* possible. + ;; Fix by Sudish Joseph + (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) + (setq dir + (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) + (if dir + (nnheader-insert + "211 %d %d %d %s\n" (length dir) (car dir) + (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) + group) + (nnheader-report 'nnspool "Empty group %s" group) + (nnheader-insert "211 0 0 0 %s\n" group)))))) + +(defun nnspool-request-type (group &optional article) + 'news) (defun nnspool-close-group (group &optional server) t) @@ -338,12 +330,11 @@ there.") (apply 'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches) (error - (setq nnspool-status-string (format "inews error: %S" err)) - nil)))) + (nnheader-report 'nnspool "inews error: %S" err))))) (if (not proc) ;; The inews program failed. () - (setq nnspool-status-string "") + (nnheader-report 'nnspool "") (set-process-sentinel proc 'nnspool-inews-sentinel) (process-send-region proc (point-min) (point-max)) ;; We slap a condition-case around this, because the process may @@ -363,7 +354,7 @@ there.") ;; Make status message by folding lines. (while (re-search-forward "[ \t\n]+" nil t) (replace-match " " t t)) - (setq nnspool-status-string (buffer-string)) + (nnheader-report 'nnspool "%s" (buffer-string)) (message "nnspool: %s" nnspool-status-string) (ding) (run-hooks 'nnspool-rejected-article-hook)))) @@ -374,10 +365,8 @@ there.") (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil - (let ((nov (concat (file-name-as-directory nnspool-nov-directory) - (nnspool-replace-chars-in-string - nnspool-current-group ?. ?/) - "/.overview"))) + (let ((nov (nnheader-group-pathname + nnspool-current-group nnspool-nov-directory ".overview"))) (if (not (file-exists-p nov)) () (save-excursion @@ -448,7 +437,9 @@ there.") (set-buffer (get-buffer-create " *nnspool work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (call-process "grep" nil t nil id nnspool-history-file) + (condition-case () + (call-process "grep" nil t nil id nnspool-history-file) + (error nil)) (goto-char (point-min)) (prog1 (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") @@ -464,50 +455,17 @@ there.") (file-error nil))) (defun nnspool-possibly-change-directory (group) - (if group - (let ((pathname (nnspool-article-pathname group))) - (if (file-directory-p pathname) - (progn - (setq nnspool-current-directory pathname) - (setq nnspool-current-group group)) - (setq nnspool-status-string - (format "No such newsgroup: %s" group)) - nil)) - t)) + (if (not group) + t + (let ((pathname (nnspool-article-pathname group))) + (if (file-directory-p pathname) + (setq nnspool-current-directory pathname + nnspool-current-group group) + (nnheader-report 'nnspool "No such newsgroup: %s" group))))) (defun nnspool-article-pathname (group &optional article) "Find the path for GROUP." - (concat - (file-name-as-directory nnspool-spool-directory) - (nnspool-replace-chars-in-string group ?. ?/) - "/" - (if article (int-to-string article) ""))) - -(defun nnspool-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (if (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - -(defun nnspool-number-base-10 (num pos) - (if (<= pos 0) "" - (setcdr num (+ (* (% (car num) 10) 65536) (cdr num))) - (apply - 'concat - (reverse - (list - (char-to-string - (aref "0123456789" (% (cdr num) 10))) - (progn - (setcdr num (/ (cdr num) 10)) - (setcar num (/ (car num) 10)) - (nnspool-number-base-10 num (1- pos)))))))) + (nnheader-group-pathname group nnspool-spool-directory article)) (defun nnspool-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) @@ -519,7 +477,7 @@ there.") (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) (nth 4 tdate)))) (+ (* (car unix) 65536.0) - (car (cdr unix))))) + (cadr unix)))) (provide 'nnspool)