Path: utzoo!utgpu!jarvis.csri.toronto.edu!rutgers!apple!motcsd!hpda!hpycla!ouicsu!creamy!etlcom!titcca!fgw!flab!umerin From: umerin@flab.flab.Fujitsu.JUNET (Masanobu UMEDA) Newsgroups: comp.emacs,fj.editor.emacs Subject: GNUS 3.12: an NNTP-based newsreader for GNU Emacs (06 of 10) Message-ID: Date: 19 Jun 89 05:31:22 GMT Sender: umerin@flab.flab.fujitsu.JUNET Followup-To: comp.emacs Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan. Lines: 1442 ---- Cut Here and unpack ---- #!/bin/sh # this is part 6 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file gnuspost.el continued # CurArch=6 if test ! -r s2_seq_.tmp then echo "Please unpack part 1 first!" exit 1; fi ( read Scheck if test "$Scheck" != $CurArch then echo "Please unpack part $Scheck next!" exit 1; else exit 0; fi ) < s2_seq_.tmp || exit 1 sed 's/^X//' << 'SHAR_EOF' >> gnuspost.el X (y-or-n-p "Are you sure you want to post to all of USENET? ")) X (let ((artbuf (current-buffer)) X (newsgroups ;Default newsgroup. X (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name)) X (subject nil) X (distribution nil)) X (save-restriction X (and (not (zerop (buffer-size))) X ;;(equal major-mode 'news-mode) X (equal major-mode 'gnus-Article-mode) X (progn X ;;(news-show-all-headers) X (gnus-Article-show-all-headers) X (narrow-to-region (point-min) X (progn (goto-char (point-min)) X (search-forward "\n\n") X (- (point) 2))))) X (setq news-reply-yank-from (mail-fetch-field "from") X news-reply-yank-message-id (mail-fetch-field "message-id"))) X (pop-to-buffer "*post-news*") X (news-reply-mode) X (gnus-replace-functions) X (if (and (buffer-modified-p) X (not (y-or-n-p "Unsent article being composed; erase it? "))) X ;; Continue composition. X ;; Make news-reply-yank-original work on the current article. X (setq mail-reply-buffer artbuf) X (erase-buffer) X (if gnus-interactive-post X ;; Newsgroups, subject and distribution are asked for. X ;; Suggested by yuki@flab.fujitsu.junet. X (progn X ;; Subscribed newsgroup names are required for X ;; completing read of newsgroup. X (or gnus-newsrc-assoc X (gnus-read-newsrc-file)) X ;; Which do you like? (UMERIN) X ;; (setq newsgroups (read-string "Newsgroups: " "general")) X (or newsgroups ;Use the default newsgroup. X (setq newsgroups X (completing-read "Newsgroup: " gnus-newsrc-assoc X nil 'require-match X newsgroups ;Default newsgroup. X ))) X (setq subject (read-string "Subject: ")) X (setq distribution X (substring newsgroups 0 (string-match "\\." newsgroups))) X (if (string-equal distribution newsgroups) X ;; Newsgroup may be general or control. In this X ;; case, use default distribution. X (setq distribution gnus-default-distribution)) X (setq distribution X (read-string "Distribution: " distribution)) X ;; An empty string is ok to ignore gnus-default-distribution. X ;;(if (string-equal distribution "") X ;; (setq distribution nil)) X )) X (news-setup () subject () newsgroups artbuf) X ;; Make sure the article is posted by GNUS. X ;;(mail-position-on-field "Posting-Software") X ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") X ;; Insert Distribution: field. X ;; Suggested by ichikawa@flab.fujitsu.junet. X (mail-position-on-field "Distribution") X (insert (or distribution gnus-default-distribution "")) X ;; Handle author copy using FCC field. X (if gnus-author-copy X (progn X (mail-position-on-field "FCC") X (insert gnus-author-copy))) X (if gnus-interactive-post X ;; All fields are filled in. X (goto-char (point-max)) X ;; Move point to Newsgroup: field. X (goto-char (point-min)) X (end-of-line)) X )) X (message ""))) X X(defun gnus-news-reply (&optional yank) X "Compose and post a reply (aka a followup) to the current article on USENET. XWhile composing the followup, use \\[news-reply-yank-original] to yank the Xoriginal message into it." X (interactive) X (if (or (not gnus-novice-user) X (y-or-n-p "Are you sure you want to followup to all of USENET? ")) X (let (from cc subject date to followup-to newsgroups message-of X references distribution message-id X (artbuf (current-buffer))) X (save-restriction X (and (not (zerop (buffer-size))) X ;;(equal major-mode 'news-mode) X (equal major-mode 'gnus-Article-mode) X (progn X ;; (news-show-all-headers) X (gnus-Article-show-all-headers) X (narrow-to-region (point-min) X (progn (goto-char (point-min)) X (search-forward "\n\n") X (- (point) 2))))) X (setq from (mail-fetch-field "from") X news-reply-yank-from from X subject (mail-fetch-field "subject") X date (mail-fetch-field "date") X followup-to (mail-fetch-field "followup-to") X newsgroups (or followup-to X (mail-fetch-field "newsgroups")) X references (mail-fetch-field "references") X distribution (mail-fetch-field "distribution") X message-id (mail-fetch-field "message-id") X news-reply-yank-message-id message-id)) X (pop-to-buffer "*post-news*") X (news-reply-mode) X (gnus-replace-functions) X (if (and (buffer-modified-p) X (not (y-or-n-p "Unsent article being composed; erase it? "))) X ;; Continue composition. X ;; Make news-reply-yank-original work on current article. X (setq mail-reply-buffer artbuf) X (erase-buffer) X (and subject X (setq subject X (concat "Re: " (gnus-simplify-subject subject 're-only)))) X (and from X (progn X (let ((stop-pos X (string-match " *at \\| *@ \\| *(\\| *<" from))) X (setq message-of X (concat X (if stop-pos (substring from 0 stop-pos) from) X "'s message of " X date))))) X (news-setup nil subject message-of newsgroups artbuf) X (if followup-to X (progn (news-reply-followup-to) X (insert followup-to))) X ;; Fold long references line to follow RFC1036. X (mail-position-on-field "References") X (let ((begin (point)) X (fill-column 79) X (fill-prefix "\t")) X (if references X (insert references)) X (if (and references message-id) X (insert " ")) X (if message-id X (insert message-id)) X ;; The region must end with a newline to fill the region X ;; without inserting extra newline. X (fill-region-as-paragraph begin (1+ (point)))) X ;; Make sure the article is posted by GNUS. X ;;(mail-position-on-field "Posting-Software") X ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") X ;; Distribution must be the same as original article. X (mail-position-on-field "Distribution") X (insert (or distribution "")) X ;; Handle author copy using FCC field. X (if gnus-author-copy X (progn X (mail-position-on-field "FCC") X (insert gnus-author-copy))) X (goto-char (point-max))) X ;; Yank original article automatically. X (if yank X (let ((last (point))) X (goto-char (point-max)) X (news-reply-yank-original nil) X (goto-char last))) X ) X (message ""))) X X(defun gnus-inews-news () X "Send a news message." X (interactive) X (let* ((case-fold-search nil) X (server-running (gnus-server-opened))) X (save-excursion X ;; It is possible to post a news without reading news using X ;; `gnus' before. X ;; Suggested by yuki@flab.fujitsu.junet. X (gnus-start-news-server) ;Use default NNTP server. X ;; NNTP server must be opened before current buffer is modified. X (widen) X (goto-char (point-min)) X (run-hooks 'news-inews-hook) X (goto-char (point-min)) X (search-forward (concat "\n" mail-header-separator "\n")) X (replace-match "\n\n") X (goto-char (point-max)) X ;; require a newline at the end for inews to append .signature to X (or (= (preceding-char) ?\n) X (insert ?\n)) X (message "Posting to USENET...") X ;; Post to NNTP server. X (if (gnus-inews-article) X (message "Posting to USENET... done") X ;; We cannot signal an error. X (ding) (message "Article rejected: %s" (gnus-status-message))) X (goto-char (point-min)) ;restore internal header separator X (search-forward "\n\n") X (replace-match (concat "\n" mail-header-separator "\n")) X (set-buffer-modified-p nil)) X ;; If NNTP server is opened by gnus-inews-news, close it by myself. X (or server-running X (gnus-close-server)) X (and (fboundp 'bury-buffer) (bury-buffer)))) X X(defun gnus-cancel-news () X "Cancel an article you posted." X (interactive) X (if (yes-or-no-p "Do you really want to cancel this article? ") X (let ((from nil) X (newsgroups nil) X (message-id nil) X (distribution nil)) X (save-excursion X ;; Get header info. from original article. X (save-restriction X (gnus-Article-show-all-headers) X (goto-char (point-min)) X (search-forward "\n\n") X (narrow-to-region (point-min) (point)) X (setq from (mail-fetch-field "from")) X (setq newsgroups (mail-fetch-field "newsgroups")) X (setq message-id (mail-fetch-field "message-id")) X (setq distribution (mail-fetch-field "distribution"))) X ;; Verify if the article is absolutely user's by comparing X ;; user id with value of its From: field. X (if (not X (string-equal X (downcase (mail-strip-quoted-names from)) X (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) X (progn X (ding) (message "This article is not yours")) X ;; Make control article. X (set-buffer (get-buffer-create " *GNUS-posting*")) X (buffer-flush-undo (current-buffer)) X (erase-buffer) X (insert "Newsgroups: " newsgroups "\n" X "Subject: cancel " message-id "\n" X "Control: cancel " message-id "\n" X ;; We should not use the value of X ;; `gnus-default-distribution' as default value, X ;; because distribution must be as same as original X ;; article. X "Distribution: " (or distribution "") "\n" X ) X ;; Prepare article headers. X (gnus-inews-insert-headers) X (goto-char (point-max)) X ;; Insert empty line. X (insert "\n") X ;; Send the control article to NNTP server. X (message "Canceling your article...") X (if (gnus-request-post) X (message "Canceling your article... done") X (ding) (message "Failed to cancel your article")) X (kill-buffer (current-buffer)) X ))) X )) X X X X(defun gnus-inews-article () X "NNTP inews interface." X (let ((signature X (if gnus-signature-file X (expand-file-name gnus-signature-file nil))) X (distribution nil) X (artbuf (current-buffer)) X (tmpbuf (get-buffer-create " *GNUS-posting*"))) X (save-excursion X (set-buffer tmpbuf) X (buffer-flush-undo (current-buffer)) X (erase-buffer) X (insert-buffer-substring artbuf) X ;; Get distribution. X (save-restriction X (goto-char (point-min)) X (search-forward "\n\n") X (narrow-to-region (point-min) (point)) X (setq distribution (mail-fetch-field "distribution"))) X (widen) X (if signature X (progn X ;; Change signature file by distribution. X ;; Suggested by hyoko@flab.fujitsu.junet. X (if (file-exists-p (concat signature "-" distribution)) X (setq signature (concat signature "-" distribution))) X ;; Insert signature. X (if (file-exists-p signature) X (progn X (goto-char (point-max)) X (insert "--\n") X (insert-file-contents signature))) X )) X ;; Prepare article headers. X (save-restriction X (goto-char (point-min)) X (search-forward "\n\n") X (narrow-to-region (point-min) (point)) X (gnus-inews-insert-headers) X ;; Save author copy of posted article. The article must be X ;; copied before being posted because `gnus-request-post' X ;; modifies the buffer. X (let ((case-fold-search t)) X ;; Find and handle any FCC fields. X (goto-char (point-min)) X (if (re-search-forward "^FCC:" nil t) X (gnus-inews-do-fcc)))) X (widen) X ;; Run final inews hooks. X (run-hooks 'gnus-Inews-article-hook) X ;; Post an article to NNTP server. X ;; Return NIL if post failed. X (prog1 X (gnus-request-post) X (kill-buffer (current-buffer))) X ))) X X(defun gnus-inews-do-fcc () X "Process FCC: fields." X (let ((fcc-list nil) X (fcc-file nil) X (case-fold-search t)) ;Should ignore case. X (save-excursion X (save-restriction X (goto-char (point-min)) X (while (re-search-forward "^FCC:[ \t]*" nil t) X (setq fcc-list (cons (buffer-substring (point) X (progn X (end-of-line) X (skip-chars-backward " \t") X (point))) X fcc-list)) X (delete-region (match-beginning 0) X (progn (forward-line 1) (point)))) X ;; Process FCC operations. X (widen) X (while fcc-list X (setq fcc-file (car fcc-list)) X (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) X (let ((program (substring fcc-file X (match-beginning 1) (match-end 1)))) X ;; Suggested by yuki@flab.fujitsu.junet. X ;; Pipe out article to named program. X (call-process-region (point-min) (point-max) shell-file-name X nil nil nil "-c" program) X )) X (t X ;; Suggested by hyoko@flab.fujitsu.junet. X ;; Save article in Unix mail format. X ;; This is much convenient for Emacs user. X (rmail-output fcc-file))) X (setq fcc-list (cdr fcc-list))) X )) X )) X X(defun gnus-inews-insert-headers () X "Prepare article headers. XPath:, From:, Subject: and Distribution: are generated. XMessage-ID:, Date:, and Organization: is optional." X (save-excursion X (let ((date (gnus-inews-date)) X (message-id (gnus-inews-message-id)) X (organization (gnus-inews-organization))) X ;; Insert from the top of headers. X (goto-char (point-min)) X (insert "Path: " (gnus-inews-path) "\n") X (insert "From: " (gnus-inews-user-name) "\n") X ;; If there is no subject, make Subject: field. X (or (mail-fetch-field "subject") X (insert "Subject: \n")) X ;; Insert random headers. X (if message-id X (insert "Message-ID: " message-id "\n")) X (if date X (insert "Date: " date "\n")) X (if organization X (let ((begin (point)) X (fill-column 79) X (fill-prefix "\t")) X (insert "Organization: " organization "\n") X (fill-region-as-paragraph begin (point)))) X (or (mail-fetch-field "distribution") X (insert "Distribution: \n")) X ))) X X(defun gnus-inews-path () X "Return uucp path." X (let ((login-name (gnus-inews-login-name))) X (cond ((null gnus-use-generic-path) X (concat gnus-nntp-server "!" login-name)) X ((stringp gnus-use-generic-path) X ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. X (concat gnus-use-generic-path "!" login-name)) X (t login-name)) X )) X X(defun gnus-inews-user-name () X "Return user's network address as `NAME@DOMAIN (FULL NAME)'." X (let ((login-name (gnus-inews-login-name)) X (full-name (gnus-inews-full-name))) X (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from) X ;; User's full name. X (cond ((string-equal full-name "") "") X ((string-equal full-name "&") ;Unix hack. X (concat " (" login-name ")")) X (t X (concat " (" full-name ")"))) X ))) X X(defun gnus-inews-login-name () X "Return user login name. XGot from the variable gnus-user-login-name, the environment variables XUSER and LOGNAME, and the function user-login-name." X (or gnus-user-login-name X (getenv "USER") (getenv "LOGNAME") (user-login-name))) X X(defun gnus-inews-full-name () X "Return user full name. XGot from the variable gnus-user-full-name, the environment variable XNAME, and the function user-full-name." X (or gnus-user-full-name X (getenv "NAME") (user-full-name))) X X(defun gnus-inews-domain-name (&optional genericfrom) X "Return user's domain name. XIf optional argument GENERICFROM is a string, use it as the domain Xname; if it is non-nil, strip of local host name from the domain name. XIf the function `system-name' returns full internet name and the Xdomain is undefined, the domain name is got from it." X (let ((domain (or (if (stringp genericfrom) genericfrom) X (getenv "DOMAINNAME") X gnus-your-domain X ;; Function `system-name' may return full internet name. X ;; Suggested by Mike DeCorte . X (if (string-match "\\." (system-name)) X (substring (system-name) (match-end 0))) X (read-string "Domain name (no host): "))) X (host (or (if (string-match "\\." (system-name)) X (substring (system-name) 0 (match-beginning 0))) X (system-name)))) X (if (string-equal "." (substring domain 0 1)) X (setq domain (substring domain 1))) X (if (null gnus-your-domain) X (setq gnus-your-domain domain)) X ;; Support GENERICFROM as same as standard Bnews system. X ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. X (cond ((null genericfrom) X (concat host "." domain)) X ;;((stringp genericfrom) genericfrom) X (t domain)) X )) X X(defun gnus-inews-message-id () X "Generate unique Message-ID for user." X ;; Message-ID should not contain a slash and should be terminated by X ;; a number. I don't know the reason why it is so. X (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">")) X X(defun gnus-inews-unique-id () X "Generate unique ID from user name and current time." X (let ((date (current-time-string)) X (name (gnus-inews-login-name))) X (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" X date) X (concat (upcase name) "." X (substring date (match-beginning 6) (match-end 6)) ;Year X (substring date (match-beginning 1) (match-end 1)) ;Month X (substring date (match-beginning 2) (match-end 2)) ;Day X (substring date (match-beginning 3) (match-end 3)) ;Hour X (substring date (match-beginning 4) (match-end 4)) ;Minute X (substring date (match-beginning 5) (match-end 5)) ;Second X ) X (error "Cannot understand current-time-string: %s." date)) X )) X X(defun gnus-inews-date () X "Bnews date format string of today. Time zone is ignored." X ;; Insert buggy date (time zone is ignored), but I don't worry about X ;; it since inews will rewrite it. X (let ((date (current-time-string))) X (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" X date) X (concat (substring date (match-beginning 2) (match-end 2)) ;Day X " " X (substring date (match-beginning 1) (match-end 1)) ;Month X " " X (substring date (match-beginning 4) (match-end 4)) ;Year X " " X (substring date (match-beginning 3) (match-end 3))) ;Time X (error "Cannot understand current-time-string: %s." date)) X )) X X(defun gnus-inews-organization () X "Return user's organization. XThe ORGANIZATION environment variable is used if defined. XIf not, the variable gnus-your-organization is used instead. XIf the value begins with a slash, it is taken as the name of a file Xcontaining the organization." X ;; The organization must be got in this order since the ORGANIZATION X ;; environment variable is intended for user specific while X ;; gnus-your-organization is for machine or organization specific. X (let ((organization (or (getenv "ORGANIZATION") X gnus-your-organization X (expand-file-name "~/.organization" nil)))) X (and (stringp organization) X (string-equal (substring organization 0 1) "/") X ;; Get it from the user and system file. X ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). X (let ((dist (mail-fetch-field "distribution"))) X (setq organization X (cond ((file-exists-p (concat organization "-" dist)) X (concat organization "-" dist)) X ((file-exists-p organization) organization) X ((file-exists-p gnus-organization-file) X gnus-organization-file) X (t organization))) X )) X (cond ((not (stringp organization)) nil) X ((and (string-equal (substring organization 0 1) "/") X (file-exists-p organization)) X ;; If the first character is `/', assume it is the name of X ;; a file containing the organization. X (save-excursion X (let ((tmpbuf (get-buffer-create " *GNUS organization*"))) X (set-buffer tmpbuf) X (erase-buffer) X (insert-file-contents organization) X (prog1 (buffer-string) X (kill-buffer tmpbuf)) X ))) X (t organization)) X )) SHAR_EOF chmod 0644 gnuspost.el || echo "restore of gnuspost.el fails" set `wc -c gnuspost.el`;Sum=$1 if test "$Sum" != "20619" then echo original size 20619, current size $Sum;fi sed 's/^X//' << 'SHAR_EOF' > mhspool.el && X;;; MH folder access using NNTP for GNU Emacs X;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD. X;; Copyright (C) 1988, 1989 Masanobu UMEDA X;; $Header: mhspool.el,v 1.4 89/06/19 13:38:20 umerin Exp $ X X;; This file is part of GNU Emacs. X X;; GNU Emacs is distributed in the hope that it will be useful, X;; but WITHOUT ANY WARRANTY. No author or distributor X;; accepts responsibility to anyone for the consequences of using it X;; or for whether it serves any particular purpose or works at all, X;; unless he says so in writing. Refer to the GNU Emacs General Public X;; License for full details. X X;; Everyone is granted permission to copy, modify and redistribute X;; GNU Emacs, but only under the conditions described in the X;; GNU Emacs General Public License. A copy of this license is X;; supposed to have been given to you along with GNU Emacs so you X;; can know your rights and responsibilities. It should be in a X;; file named COPYING. Among other things, the copyright notice X;; and this notice must be preserved on all copies. X X(provide 'mhspool) X(require 'nntp) X X;; This package enables you to read mail or articles in MH folders, or X;; articles saved by GNUS. In any case, the file names of mail or X;; articles must consist of only numeric letters. X X;; Before using this package, you have to create a server specific X;; startup file according to the directory which you want to read. For X;; example, if you want to read mail under the directory named X;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is X;; no way to specify hierarchical directory now.) In this case, the X;; name of the NNTP server passed to GNUS must be `:Mail'. X X(defvar mhspool-list-directory-switches "-R" X "*Switches for nntp-request-list to pass to `ls' for gettting file lists. XOne entry should appear on one line. You may need to add `-1' option.") X X X X(defconst mhspool-version "MHSPOOL 1.4" X "Version numbers of this version of MHSPOOL.") X X(defvar mhspool-spool-directory "~/Mail" X "Private mail directory.") X X(defvar mhspool-current-directory nil X "Current news group directory.") X X;;; X;;; Replacement of Extended Command for retrieving many headers. X;;; X X(defun mhspool-retrieve-headers (sequence) X "Return list of article headers specified by SEQUENCE of article id. XThe format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'. XReader macros for the vector are defined as `nntp-header-FIELD'. XWriter macros for the vector are defined as `nntp-set-header-FIELD'. XNews group must be selected before calling me." X (save-excursion X (set-buffer nntp-server-buffer) X ;;(erase-buffer) X (let ((file nil) X (number (length sequence)) X (count 0) X (headers nil) ;Result list. X (article 0) X (subject nil) X (message-id nil) X (from nil) X (xref nil) X (lines 0) X (date nil)) X (while sequence X ;;(nntp-send-strings-to-server "HEAD" (car sequence)) X (setq article (car sequence)) X (setq file X (concat mhspool-current-directory (prin1-to-string article))) X (if (and (file-exists-p file) X (not (file-directory-p file))) X (progn X (erase-buffer) X (insert-file-contents file) X (goto-char (point-min)) X (search-forward "\n\n" nil 'move) X (narrow-to-region (point-min) (point)) X ;; Make it possible to search `\nFIELD'. X (goto-char (point-min)) X (insert "\n") X ;; Extract From: X (goto-char (point-min)) X (if (search-forward "\nFrom: " nil t) X (setq from (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq from "Unknown User")) X ;; Extract Subject: X (goto-char (point-min)) X (if (search-forward "\nSubject: " nil t) X (setq subject (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq subject "(None)")) X ;; Extract Message-ID: X (goto-char (point-min)) X (if (search-forward "\nMessage-ID: " nil t) X (setq message-id (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq message-id nil)) X ;; Extract Date: X (goto-char (point-min)) X (if (search-forward "\nDate: " nil t) X (setq date (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq date nil)) X ;; Extract Lines: X (goto-char (point-min)) X (if (search-forward "\nLines: " nil t) X (setq lines (string-to-int X (buffer-substring X (point) X (save-excursion (end-of-line) (point))))) X (setq lines 0)) X ;; Extract Xref: X (goto-char (point-min)) X (if (search-forward "\nXref: " nil t) X (setq xref (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq xref nil)) X (setq headers X (cons (vector article subject from X xref lines date message-id) X headers)) X )) X (setq sequence (cdr sequence)) X (setq count (1+ count)) X (if (and (> number nntp-large-newsgroup) X (zerop (% count 20))) X (message "MHSPOOL: %d%% of headers received." X (/ (* count 100) number))) X ) X (if (> number nntp-large-newsgroup) X (message "MHSPOOL: 100%% of headers received.")) X (nreverse headers) X ))) X X;;; X;;; Replacement of NNTP Raw Interface. X;;; X X(defun mhspool-open-server (host &optional service) X "Open news server on HOST. XIf HOST is nil, use value of environment variable `NNTPSERVER'. XIf optional argument SERVICE is non-nil, open by the service name." X (let ((host (or host (getenv "NNTPSERVER"))) X (status nil)) X ;; Get directory name from HOST name. X (if (string-match ":\\(.+\\)$" host) X (progn X (setq mhspool-spool-directory X (file-name-as-directory X (expand-file-name X (substring host (match-beginning 1) (match-end 1)) X (expand-file-name "~/" nil)))) X (setq host (system-name))) X (setq mhspool-spool-directory nil)) X (setq nntp-status-message-string "") X (cond ((and (stringp host) X (stringp mhspool-spool-directory) X (file-directory-p mhspool-spool-directory) X (string-equal host (system-name))) X (setq status (mhspool-open-server-internal host service))) X ((string-equal host (system-name)) X (setq nntp-status-message-string X (format "No such directory: %s. Goodbye." X mhspool-spool-directory))) X ((null host) X (setq nntp-status-message-string "NNTP server is not specified.")) X (t X (setq nntp-status-message-string X (format "MHSPOOL: cannot talk to %s." host))) X ) X status X )) X X(defun mhspool-close-server () X "Close news server." X (mhspool-close-server-internal)) X X(fset 'mhspool-request-quit (symbol-function 'mhspool-close-server)) X X(defun mhspool-server-opened () X "Return server process status, T or NIL. XIf the stream is opened, return T, otherwise return NIL." X (and nntp-server-buffer X (get-buffer nntp-server-buffer))) X X(defun mhspool-status-message () X "Return server status response as string." X nntp-status-message-string X ) X X(defun mhspool-request-article (id) X "Select article by message ID (or number)." X (let ((file (concat mhspool-current-directory (prin1-to-string id)))) X (if (and (stringp file) X (file-exists-p file) X (not (file-directory-p file))) X (save-excursion X (mhspool-find-file file))) X )) X X(defun mhspool-request-body (id) X "Select article body by message ID (or number)." X (if (mhspool-request-article id) X (save-excursion X (set-buffer nntp-server-buffer) X (goto-char (point-min)) X (if (search-forward "\n\n" nil t) X (delete-region (point-min) (point))) X t X ) X )) X X(defun mhspool-request-head (id) X "Select article head by message ID (or number)." X (if (mhspool-request-article id) X (save-excursion X (set-buffer nntp-server-buffer) X (goto-char (point-min)) X (if (search-forward "\n\n" nil t) X (delete-region (1- (point)) (point-max))) X t X ) X )) X X(defun mhspool-request-stat (id) X "Select article by message ID (or number)." X (error "MHSPOOL: STAT is not implemented.")) X X(defun mhspool-request-group (group) X "Select news GROUP." X (cond ((file-directory-p X (mhspool-article-pathname group)) X ;; Mail/NEWS.GROUP/N X (setq mhspool-current-directory X (mhspool-article-pathname group))) X ((file-directory-p X (mhspool-article-pathname X (mhspool-replace-chars-in-string group ?. ?/))) X ;; Mail/NEWS/GROUP/N X (setq mhspool-current-directory X (mhspool-article-pathname X (mhspool-replace-chars-in-string group ?. ?/)))) X )) X X(defun mhspool-request-list () X "List valid newsgoups." X (save-excursion X (let* ((newsgroup nil) X (articles nil) X (directory (file-name-as-directory X (expand-file-name mhspool-spool-directory nil))) X (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$")) X (buffer (get-buffer-create " *GNUS file listing*"))) X (set-buffer nntp-server-buffer) X (erase-buffer) X (set-buffer buffer) X (erase-buffer) X (call-process "ls" nil t nil mhspool-list-directory-switches directory) X (goto-char (point-min)) X (while (re-search-forward folder-regexp nil t) X (setq newsgroup X (mhspool-replace-chars-in-string X (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.)) X (setq articles nil) X (forward-line 1) ;(beginning-of-line) X ;; Thank nobu@flab.fujitsu.junet for his bug fixes. X (while (and (not (eobp)) X (not (looking-at "^$"))) X (if (looking-at "^[0-9]+$") X (setq articles X (cons (string-to-int X (buffer-substring X (match-beginning 0) (match-end 0))) X articles))) X (forward-line 1)) X (if articles X (princ (format "%s %d %d n\n" newsgroup X (apply (function max) articles) X (apply (function min) articles)) X nntp-server-buffer)) X ) X (kill-buffer buffer) X (set-buffer nntp-server-buffer) X (buffer-size) X ))) X X(defun mhspool-request-last () X "Set current article pointer to the previous article Xin the current news group." X (error "MHSPOOL: LAST is not implemented.")) X X(defun mhspool-request-next () X "Advance current article pointer." X (error "MHSPOOL: NEXT is not implemented.")) X X(defun mhspool-request-post () X "Post a new news in current buffer." X (setq nntp-status-message-string "MHSPOOL: what do you mean post?") X nil X ) X X X;;; X;;; Replacement of Low-Level Interface to NNTP Server. X;;; X X(defun mhspool-open-server-internal (host &optional service) X "Open connection to news server on HOST by SERVICE (default is nntp)." X (save-excursion X (if (not (string-equal host (system-name))) X (error "MHSPOOL: cannot talk to %s." host)) X ;; Initialize communication buffer. X (setq nntp-server-buffer (get-buffer-create " *nntpd*")) X (set-buffer nntp-server-buffer) X (buffer-flush-undo (current-buffer)) X (erase-buffer) X (kill-all-local-variables) X (setq case-fold-search t) ;Should ignore case. X (setq nntp-server-process nil) X (setq nntp-server-name host) X ;; It is possible to change kanji-fileio-code in this hook. X (run-hooks 'nntp-server-hook) X t X )) X X(defun mhspool-close-server-internal () X "Close connection to news server." X (if nntp-server-buffer X (kill-buffer nntp-server-buffer)) X (setq nntp-server-buffer nil) X (setq nntp-server-process nil)) X X(defun mhspool-find-file (file) X "Insert FILE in server buffer safely." X (set-buffer nntp-server-buffer) X (erase-buffer) X (condition-case () X (progn X (insert-file-contents file) X (goto-char (point-min)) X ;; If there is no body, `^L' appears at end of file. Special X ;; hack for MH folder. X (and (search-forward "\n\n" nil t) X (string-equal (buffer-substring (point) (point-max)) "\^L") X (delete-char 1)) X t X ) X (file-error nil) X )) X X(defun mhspool-article-pathname (group) X "Make pathname for GROUP." X (concat (file-name-as-directory mhspool-spool-directory) group "/")) X X(defun mhspool-replace-chars-in-string (string from to) X "Replace characters in STRING from FROM to TO." X (let ((string (substring string 0)) ;Copy string. X (len (length string)) X (idx 0)) X ;; Replace all occurence of FROM with TO. X (while (< idx len) X (if (= (aref string idx) from) X (aset string idx to)) X (setq idx (1+ idx))) X string X )) SHAR_EOF chmod 0644 mhspool.el || echo "restore of mhspool.el fails" set `wc -c mhspool.el`;Sum=$1 if test "$Sum" != "12157" then echo original size 12157, current size $Sum;fi sed 's/^X//' << 'SHAR_EOF' > nnspool.el && X;;; Spool access using NNTP for GNU Emacs X;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD. X;; Copyright (C) 1988, 1989 Masanobu UMEDA X;; $Header: nnspool.el,v 1.9 89/06/19 13:38:47 umerin Exp $ X X;; This file is part of GNU Emacs. X X;; GNU Emacs is distributed in the hope that it will be useful, X;; but WITHOUT ANY WARRANTY. No author or distributor X;; accepts responsibility to anyone for the consequences of using it X;; or for whether it serves any particular purpose or works at all, X;; unless he says so in writing. Refer to the GNU Emacs General Public X;; License for full details. X X;; Everyone is granted permission to copy, modify and redistribute X;; GNU Emacs, but only under the conditions described in the X;; GNU Emacs General Public License. A copy of this license is X;; supposed to have been given to you along with GNU Emacs so you X;; can know your rights and responsibilities. It should be in a X;; file named COPYING. Among other things, the copyright notice X;; and this notice must be preserved on all copies. X X(provide 'nnspool) X(require 'nntp) X X(defvar nnspool-inews-program news-inews-program X "*Program to post news.") X X(defvar nnspool-inews-switches "-h" X "*Switches for nnspool-request-post to pass to `inews' for posting news.") X X(defvar nnspool-spool-directory news-path X "*Local news spool directory.") X X(defvar nnspool-active-file "/usr/lib/news/active" X "*Local news active file.") X X(defvar nnspool-history-file "/usr/lib/news/history" X "*Local news history file.") X X X X(defconst nnspool-version "NNSPOOL 1.9" X "Version numbers of this version of NNSPOOL.") X X(defvar nnspool-current-directory nil X "Current news group directory.") X X;;; X;;; Replacement of Extended Command for retrieving many headers. X;;; X X(defun nnspool-retrieve-headers (sequence) X "Return list of article headers specified by SEQUENCE of article id. XThe format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'. XReader macros for the vector are defined as `nntp-header-FIELD'. XWriter macros for the vector are defined as `nntp-set-header-FIELD'. XNews group must be selected before calling me." X (save-excursion X (set-buffer nntp-server-buffer) X ;;(erase-buffer) X (let ((file nil) X (number (length sequence)) X (count 0) X (headers nil) ;Result list. X (article 0) X (subject nil) X (message-id nil) X (from nil) X (xref nil) X (lines 0) X (date nil)) X (while sequence X ;;(nntp-send-strings-to-server "HEAD" (car sequence)) X (setq article (car sequence)) X (setq file X (concat nnspool-current-directory (prin1-to-string article))) X (if (and (file-exists-p file) X (not (file-directory-p file))) X (progn X (erase-buffer) X (insert-file-contents file) X (goto-char (point-min)) X (search-forward "\n\n" nil 'move) X (narrow-to-region (point-min) (point)) X ;; Make it possible to search `\nFIELD'. X (goto-char (point-min)) X (insert "\n") X ;; Extract From: X (goto-char (point-min)) X (if (search-forward "\nFrom: " nil t) X (setq from (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq from "Unknown User")) X ;; Extract Subject: X (goto-char (point-min)) X (if (search-forward "\nSubject: " nil t) X (setq subject (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq subject "(None)")) X ;; Extract Message-ID: X (goto-char (point-min)) X (if (search-forward "\nMessage-ID: " nil t) X (setq message-id (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq message-id nil)) X ;; Extract Date: X (goto-char (point-min)) X (if (search-forward "\nDate: " nil t) X (setq date (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq date nil)) X ;; Extract Lines: X (goto-char (point-min)) X (if (search-forward "\nLines: " nil t) X (setq lines (string-to-int X (buffer-substring X (point) X (save-excursion (end-of-line) (point))))) X (setq lines 0)) X ;; Extract Xref: X (goto-char (point-min)) X (if (search-forward "\nXref: " nil t) X (setq xref (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X (setq xref nil)) X (setq headers X (cons (vector article subject from X xref lines date message-id) X headers)) X )) X (setq sequence (cdr sequence)) X (setq count (1+ count)) X (if (and (> number nntp-large-newsgroup) X (zerop (% count 20))) X (message "NNSPOOL: %d%% of headers received." X (/ (* count 100) number))) X ) X (if (> number nntp-large-newsgroup) X (message "NNSPOOL: 100%% of headers received.")) X (nreverse headers) X ))) X X X;;; X;;; Replacement of NNTP Raw Interface. X;;; X X(defun nnspool-open-server (host &optional service) X "Open news server on HOST. XIf HOST is nil, use value of environment variable `NNTPSERVER'. XIf optional argument SERVICE is non-nil, open by the service name." X (let ((host (or host (getenv "NNTPSERVER"))) X (status nil)) X (setq nntp-status-message-string "") X (cond ((and (file-directory-p nnspool-spool-directory) X (file-exists-p nnspool-active-file) X (string-equal host (system-name))) X (setq status (nnspool-open-server-internal host service))) X ((string-equal host (system-name)) X (setq nntp-status-message-string X (format "%s has no news spool. Goodbye." host))) X ((null host) X (setq nntp-status-message-string "NNTP server is not specified.")) X (t X (setq nntp-status-message-string X (format "NNSPOOL: cannot talk to %s." host))) X ) X status X )) X X(defun nnspool-close-server () X "Close news server." X (nnspool-close-server-internal)) X X(fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) X X(defun nnspool-server-opened () X "Return server process status, T or NIL. XIf the stream is opened, return T, otherwise return NIL." X (and nntp-server-buffer X (get-buffer nntp-server-buffer))) X X(defun nnspool-status-message () X "Return server status response as string." X nntp-status-message-string X ) X X(defun nnspool-request-article (id) X "Select article by message ID (or number)." X (let ((file (if (stringp id) X (nnspool-find-article-by-message-id id) X (concat nnspool-current-directory (prin1-to-string id))))) X (if (and (stringp file) X (file-exists-p file) X (not (file-directory-p file))) X (save-excursion X (nnspool-find-file file))) X )) X X(defun nnspool-request-body (id) X "Select article body by message ID (or number)." X (if (nnspool-request-article id) X (save-excursion X (set-buffer nntp-server-buffer) X (goto-char (point-min)) X (if (search-forward "\n\n" nil t) X (delete-region (point-min) (point))) X t X ) X )) X X(defun nnspool-request-head (id) X "Select article head by message ID (or number)." X (if (nnspool-request-article id) X (save-excursion X (set-buffer nntp-server-buffer) X (goto-char (point-min)) X (if (search-forward "\n\n" nil t) X (delete-region (1- (point)) (point-max))) X t X ) X )) X X(defun nnspool-request-stat (id) X "Select article by message ID (or number)." X (error "NNSPOOL: STAT is not implemented.")) X X(defun nnspool-request-group (group) X "Select news GROUP." X (let ((pathname (nnspool-article-pathname X (nnspool-replace-chars-in-string group ?. ?/)))) X (if (file-directory-p pathname) X (setq nnspool-current-directory pathname)) X )) X X(defun nnspool-request-list () X "List valid newsgoups." X (save-excursion X (nnspool-find-file nnspool-active-file))) X X(defun nnspool-request-last () X "Set current article pointer to the previous article Xin the current news group." X (error "NNSPOOL: LAST is not implemented.")) X X(defun nnspool-request-next () X "Advance current article pointer." X (error "NNSPOOL: NEXT is not implemented.")) X X(defun nnspool-request-post () X "Post a new news in current buffer." X (save-excursion X ;; We have to work in the server buffer because of NEmacs hack. X (copy-to-buffer nntp-server-buffer (point-min) (point-max)) X (set-buffer nntp-server-buffer) X (call-process-region (point-min) (point-max) X nnspool-inews-program 'delete t nil X nnspool-inews-switches X ) X (prog1 X (or (zerop (buffer-size)) X ;; If inews returns strings, it must be error message X ;; unless SPOOLNEWS is defined. X ;; This condition is very weak, but there is no good rule X ;; identifying errors when SPOOLNEWS is defined. X ;; Suggested by ohm@kaba.junet. X (string-match "spooled" (buffer-string))) X ;; Make status message by unfolding lines. X (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) X (setq nntp-status-message-string (buffer-string)) X (erase-buffer)) X )) X X X;;; X;;; Replacement of Low-Level Interface to NNTP Server. X;;; X X(defun nnspool-open-server-internal (host &optional service) X "Open connection to news server on HOST by SERVICE (default is nntp)." X (save-excursion X (if (not (string-equal host (system-name))) X (error "NNSPOOL: cannot talk to %s." host)) X ;; Initialize communication buffer. X (setq nntp-server-buffer (get-buffer-create " *nntpd*")) X (set-buffer nntp-server-buffer) X (buffer-flush-undo (current-buffer)) X (erase-buffer) X (kill-all-local-variables) X (setq case-fold-search t) ;Should ignore case. X (setq nntp-server-process nil) X (setq nntp-server-name host) X ;; It is possible to change kanji-fileio-code in this hook. X (run-hooks 'nntp-server-hook) X t X )) X X(defun nnspool-close-server-internal () X "Close connection to news server." X (if (get-file-buffer nnspool-history-file) X (kill-buffer (get-file-buffer nnspool-history-file))) X (if nntp-server-buffer X (kill-buffer nntp-server-buffer)) X (setq nntp-server-buffer nil) X (setq nntp-server-process nil)) X X(defun nnspool-find-article-by-message-id (id) X "Return full pathname of an artilce identified by message-ID." X (save-excursion X (let ((buffer (get-file-buffer nnspool-history-file))) X (if buffer X (set-buffer buffer) X ;; Finding history file may take lots of time. X (message "Reading history file...") X (set-buffer (find-file-noselect nnspool-history-file)) X (message "Reading history file... done"))) X ;; Search from end of the file. I think this is much faster than X ;; do from the beginning of the file. X (goto-char (point-max)) X (if (re-search-backward X (concat "^" (regexp-quote id) X "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) X (let ((group (buffer-substring (match-beginning 1) (match-end 1))) X (number (buffer-substring (match-beginning 2) (match-end 2)))) X (concat (nnspool-article-pathname X (nnspool-replace-chars-in-string group ?. ?/)) X number)) X ))) X X(defun nnspool-find-file (file) X "Insert FILE in server buffer safely." X (set-buffer nntp-server-buffer) X (erase-buffer) X (condition-case () X (progn (insert-file-contents file) t) X (file-error nil) X )) X X(defun nnspool-article-pathname (group) X "Make pathname for GROUP." X (concat (file-name-as-directory nnspool-spool-directory) group "/")) X X(defun nnspool-replace-chars-in-string (string from to) X "Replace characters in STRING from FROM to TO." X (let ((string (substring string 0)) ;Copy string. X (len (length string)) X (idx 0)) X ;; Replace all occurence of FROM with TO. X (while (< idx len) X (if (= (aref string idx) from) X (aset string idx to)) X (setq idx (1+ idx))) X string X )) SHAR_EOF chmod 0644 nnspool.el || echo "restore of nnspool.el fails" set `wc -c nnspool.el`;Sum=$1 if test "$Sum" != "11538" then echo original size 11538, current size $Sum;fi sed 's/^X//' << 'SHAR_EOF' > nntp.el && X;;; NNTP (RFC977) Interface for GNU Emacs X;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD. X;; Copyright (C) 1987, 1988, 1989 Masanobu UMEDA X;; $Header: nntp.el,v 3.9 89/06/19 13:38:51 umerin Exp $ X X;; This file is part of GNU Emacs. X X;; GNU Emacs is distributed in the hope that it will be useful, X;; but WITHOUT ANY WARRANTY. No author or distributor X;; accepts responsibility to anyone for the consequences of using it X;; or for whether it serves any particular purpose or works at all, X;; unless he says so in writing. Refer to the GNU Emacs General Public X;; License for full details. X X;; Everyone is granted permission to copy, modify and redistribute X;; GNU Emacs, but only under the conditions described in the X;; GNU Emacs General Public License. A copy of this license is X;; supposed to have been given to you along with GNU Emacs so you X;; can know your rights and responsibilities. It should be in a X;; file named COPYING. Among other things, the copyright notice X;; and this notice must be preserved on all copies. X X;; This implementation is tested on both 1.2a and 1.5 version of the X;; NNTP package. X X;; Troubleshooting of NNTP X;; X;; (1) Select routine may signal an error or fall into infinite loop X;; while waiting for the server response. In this case, you'd better X;; not use byte-compiled codes but original source. If you still have X;; a problems with it, set the variable `nntp-buggy-select' to T. X;; X;; (2) Emacs may hang up while retrieving headers since too many X;; requests have been sent to the NNTP server without reading their X;; replies. In this case, reduce the number of the requests sent to X;; the server at one time by setting the variable X;; `nntp-maximum-request' to a lower value. X;; X;; (3) If the TCP/IP stream (open-network-stream) is not supported by X;; emacs, compile and install `tcp.el' and `tcp.c' which is an X;; emulation program of the stream. If you modified `tcp.c' for your X;; system, please send me the diffs. I'll include some of them in the X;; future releases. X X(provide 'nntp) X X(defvar nntp-server-hook nil X "*Hooks for the NNTP server. XIf the kanji code of the NNTP server is different from the local kanji Xcode, the correct kanji code of the buffer associated with the NNTP Xserver must be specified as follows: X X(setq nntp-server-hook X '(lambda () X ;; Server's Kanji code is EUC (NEmacs hack). X (make-local-variable 'kanji-fileio-code) X (setq kanji-fileio-code 0))) X XIf you'd like to change something depending on the server in this Xhook, use the variable `nntp-server-name'.") X X(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts)) X "*T if your select routine is buggy. XIf the select routine signals error or fall into infinite loop while Xwaiting for the server response, the variable must be set to t. In Xcase of Fujitsu UTS, it is set to T since `accept-process-output' Xdoesn't work properly.") X X(defvar nntp-maximum-request 400 X "*The maximum number of the requests sent to the NNTP server at one time. XIf Emacs hangs up while retrieving headers, set the variable to a Xlower value.") X X(defvar nntp-large-newsgroup 50 X "*The number of the articles which indicates a large newsgroup. XIf the number of the articles is greater than the value, verbose Xmessages will be shown to indicate the current status.") X X X(defconst nntp-version "NNTP 3.9" X "Version numbers of this version of NNTP.") X X(defvar nntp-server-name nil X "The name of the host running NNTP server.") X X(defvar nntp-server-buffer nil X "Buffer associated with NNTP server process.") X X(defvar nntp-server-process nil X "The NNTP server process. XYou'd better not use this variable in NNTP front-end program but Xinstead use `nntp-server-buffer'.") X X(defvar nntp-status-message-string nil X "Save the server response message. XYou'd better not use this variable in NNTP front-end program but Xinstead call function `nntp-status-message' to get status message.") X X;;; X;;; Extended Command for retrieving many headers. X;;; X;; Retrieving lots of headers by sending command asynchronously. X;; Access functions to headers are defined as macro. X X(defmacro nntp-header-number (header) X "Return article number in HEADER." X (` (aref (, header) 0))) X X(defmacro nntp-set-header-number (header number) X "Set article number of HEADER to NUMBER." X (` (aset (, header) 0 (, number)))) X X(defmacro nntp-header-subject (header) X "Return subject string in HEADER." X (` (aref (, header) 1))) X X(defmacro nntp-set-header-subject (header subject) X "Set article subject of HEADER to SUBJECT." X (` (aset (, header) 1 (, subject)))) X X(defmacro nntp-header-from (header) X "Return author string in HEADER." X (` (aref (, header) 2))) X X(defmacro nntp-set-header-from (header from) SHAR_EOF echo "End of part 6, continue with part 7" echo "7" > s2_seq_.tmp exit 0