Mercurial > emacs

comparison lisp/gnus/nnsoup.el @ 24357:15fc6acbae7a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgrading to Gnus 5.7; see ChangeLog
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Sat, 20 Feb 1999 14:05:57 +0000
parents 5f1ab3dd344d
children 6df76c3ff5c2
comparison
equal deleted inserted replaced
24356:a5a611ef40f6 24357:15fc6acbae7a
1 ;;; nnsoup.el --- SOUP access for Gnus 1 ;;; nnsoup.el --- SOUP access for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail 6 ;; Keywords: news, mail
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
9 9
66 (defvoo nnsoup-packet-directory "~/" 66 (defvoo nnsoup-packet-directory "~/"
67 "*Where nnsoup will look for incoming packets.") 67 "*Where nnsoup will look for incoming packets.")
68 68
69 (defvoo nnsoup-packet-regexp "Soupout" 69 (defvoo nnsoup-packet-regexp "Soupout"
70 "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") 70 "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
71
72 (defvoo nnsoup-always-save t
73 "If non nil commit the reply buffer on each message send.
74 This is necessary if using message mode outside Gnus with nnsoup as a
75 backend for the messages.")
71 76
72 77
73 78
74 (defconst nnsoup-version "nnsoup 0.0" 79 (defconst nnsoup-version "nnsoup 0.0"
75 "nnsoup version.") 80 "nnsoup version.")
80 (defvoo nnsoup-replies-list nil) 85 (defvoo nnsoup-replies-list nil)
81 (defvoo nnsoup-buffers nil) 86 (defvoo nnsoup-buffers nil)
82 (defvoo nnsoup-current-group nil) 87 (defvoo nnsoup-current-group nil)
83 (defvoo nnsoup-group-alist-touched nil) 88 (defvoo nnsoup-group-alist-touched nil)
84 (defvoo nnsoup-article-alist nil) 89 (defvoo nnsoup-article-alist nil)
85
86 90
87 91
88 ;;; Interface functions. 92 ;;; Interface functions.
89 93
90 (nnoo-define-basics nnsoup) 94 (nnoo-define-basics nnsoup)
411 entry number area lnum cur-prefix file) 415 entry number area lnum cur-prefix file)
412 ;; Go through all areas in the new AREAS file. 416 ;; Go through all areas in the new AREAS file.
413 (while (setq area (pop areas)) 417 (while (setq area (pop areas))
414 ;; Change the name to the permanent name and move the files. 418 ;; Change the name to the permanent name and move the files.
415 (setq cur-prefix (nnsoup-next-prefix)) 419 (setq cur-prefix (nnsoup-next-prefix))
416 (message "Incorporating file %s..." cur-prefix) 420 (nnheader-message 5 "Incorporating file %s..." cur-prefix)
417 (when (file-exists-p 421 (when (file-exists-p
418 (setq file (concat nnsoup-tmp-directory 422 (setq file (concat nnsoup-tmp-directory
419 (gnus-soup-area-prefix area) ".IDX"))) 423 (gnus-soup-area-prefix area) ".IDX")))
420 (rename-file file (nnsoup-file cur-prefix))) 424 (rename-file file (nnsoup-file cur-prefix)))
421 (when (file-exists-p 425 (when (file-exists-p
542 "Unpack all packets in `nnsoup-packet-directory'." 546 "Unpack all packets in `nnsoup-packet-directory'."
543 (let ((packets (directory-files 547 (let ((packets (directory-files
544 nnsoup-packet-directory t nnsoup-packet-regexp)) 548 nnsoup-packet-directory t nnsoup-packet-regexp))
545 packet) 549 packet)
546 (while (setq packet (pop packets)) 550 (while (setq packet (pop packets))
547 (message "nnsoup: unpacking %s..." packet) 551 (nnheader-message 5 "nnsoup: unpacking %s..." packet)
548 (if (not (gnus-soup-unpack-packet 552 (if (not (gnus-soup-unpack-packet
549 nnsoup-tmp-directory nnsoup-unpacker packet)) 553 nnsoup-tmp-directory nnsoup-unpacker packet))
550 (message "Couldn't unpack %s" packet) 554 (nnheader-message 5 "Couldn't unpack %s" packet)
551 (delete-file packet) 555 (delete-file packet)
552 (nnsoup-read-areas) 556 (nnsoup-read-areas)
553 (message "Unpacking...done"))))) 557 (nnheader-message 5 "Unpacking...done")))))
554 558
555 (defun nnsoup-narrow-to-article (article &optional area head) 559 (defun nnsoup-narrow-to-article (article &optional area head)
556 (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) 560 (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
557 (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) 561 (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
558 (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) 562 (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
612 ;;;###autoload 616 ;;;###autoload
613 (defun nnsoup-pack-replies () 617 (defun nnsoup-pack-replies ()
614 "Make an outbound package of SOUP replies." 618 "Make an outbound package of SOUP replies."
615 (interactive) 619 (interactive)
616 (unless (file-exists-p nnsoup-replies-directory) 620 (unless (file-exists-p nnsoup-replies-directory)
617 (message "No such directory: %s" nnsoup-replies-directory)) 621 (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
618 ;; Write all data buffers. 622 ;; Write all data buffers.
619 (gnus-soup-save-areas) 623 (gnus-soup-save-areas)
620 ;; Write the active file. 624 ;; Write the active file.
621 (nnsoup-write-active-file) 625 (nnsoup-write-active-file)
622 ;; Write the REPLIES file. 626 ;; Write the REPLIES file.
660 (defun nnsoup-store-reply (kind) 664 (defun nnsoup-store-reply (kind)
661 ;; Mostly stolen from `message.el'. 665 ;; Mostly stolen from `message.el'.
662 (require 'mail-utils) 666 (require 'mail-utils)
663 (let ((tembuf (generate-new-buffer " message temp")) 667 (let ((tembuf (generate-new-buffer " message temp"))
664 (case-fold-search nil) 668 (case-fold-search nil)
669 (real-header-separator mail-header-separator)
670 (mail-header-separator "")
665 delimline 671 delimline
666 (mailbuf (current-buffer))) 672 (mailbuf (current-buffer)))
667 (unwind-protect 673 (unwind-protect
668 (save-excursion 674 (save-excursion
669 (save-restriction 675 (save-restriction
685 (insert ?\n)) 691 (insert ?\n))
686 (let ((case-fold-search t)) 692 (let ((case-fold-search t))
687 ;; Change header-delimiter to be what sendmail expects. 693 ;; Change header-delimiter to be what sendmail expects.
688 (goto-char (point-min)) 694 (goto-char (point-min))
689 (re-search-forward 695 (re-search-forward
690 (concat "^" (regexp-quote mail-header-separator) "\n")) 696 (concat "^" (regexp-quote real-header-separator) "\n"))
691 (replace-match "\n") 697 (replace-match "\n")
692 (backward-char 1) 698 (backward-char 1)
693 (setq delimline (point-marker)) 699 (setq delimline (point-marker))
694 ;; Insert an extra newline if we need it to work around 700 ;; Insert an extra newline if we need it to work around
695 ;; Sun's bug that swallows newlines. 701 ;; Sun's bug that swallows newlines.
705 (when (and msg-buf (bufferp msg-buf)) 711 (when (and msg-buf (bufferp msg-buf))
706 (save-excursion 712 (save-excursion
707 (set-buffer msg-buf) 713 (set-buffer msg-buf)
708 (goto-char (point-min)) 714 (goto-char (point-min))
709 (while (re-search-forward "^#! *rnews" nil t) 715 (while (re-search-forward "^#! *rnews" nil t)
710 (incf num))) 716 (incf num))
711 (message "Stored %d messages" num))) 717 (when nnsoup-always-save
718 (save-buffer)))
719 (nnheader-message 5 "Stored %d messages" num)))
712 (nnsoup-write-replies) 720 (nnsoup-write-replies)
713 (kill-buffer tembuf)))))) 721 (kill-buffer tembuf))))))
714 722
715 (defun nnsoup-kind-to-prefix (kind) 723 (defun nnsoup-kind-to-prefix (kind)
716 (unless nnsoup-replies-list 724 (unless nnsoup-replies-list
744 (string-to-int (match-string 1 f2))))))) 752 (string-to-int (match-string 1 f2)))))))
745 active group lines ident elem min) 753 active group lines ident elem min)
746 (set-buffer (get-buffer-create " *nnsoup work*")) 754 (set-buffer (get-buffer-create " *nnsoup work*"))
747 (buffer-disable-undo (current-buffer)) 755 (buffer-disable-undo (current-buffer))
748 (while files 756 (while files
749 (message "Doing %s..." (car files)) 757 (nnheader-message 5 "Doing %s..." (car files))
750 (erase-buffer) 758 (erase-buffer)
751 (nnheader-insert-file-contents (car files)) 759 (nnheader-insert-file-contents (car files))
752 (goto-char (point-min)) 760 (goto-char (point-min))
753 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) 761 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
754 (setq group "unknown") 762 (setq group "unknown")
769 (list (cons (1+ (setq min (cdadr elem))) 777 (list (cons (1+ (setq min (cdadr elem)))
770 (+ min lines)) 778 (+ min lines))
771 (vector ident group "ncm" "" lines)))) 779 (vector ident group "ncm" "" lines))))
772 (setcdr (cadr elem) (+ min lines))) 780 (setcdr (cadr elem) (+ min lines)))
773 (setq files (cdr files))) 781 (setq files (cdr files)))
774 (message "") 782 (nnheader-message 5 "")
775 (setq nnsoup-group-alist active) 783 (setq nnsoup-group-alist active)
776 (nnsoup-write-active-file t))) 784 (nnsoup-write-active-file t)))
777 785
778 (defun nnsoup-delete-unreferenced-message-files () 786 (defun nnsoup-delete-unreferenced-message-files ()
779 "Delete any *.MSG and *.IDX files that aren't known by nnsoup." 787 "Delete any *.MSG and *.IDX files that aren't known by nnsoup."