diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/ChangeLog dgnus/lisp/ChangeLog *** pub/dgnus/lisp/ChangeLog Wed Apr 26 17:04:00 1995 --- dgnus/lisp/ChangeLog Fri Apr 28 00:53:24 1995 *************** *** 1,10 **** ! Wed Apr 26 15:57:28 1995 Lars Magne Ingebrigtsen * gnus-message.el (gnus-inews-check-post): Would warn about too long lines when the last line didn't have a newline. * gnus-score.el (gnus-score-string): Would loop forever on empty matches. Wed Apr 26 15:08:00 1995 Lars Magne Ingebrigtsen --- 1,69 ---- ! Fri Apr 28 00:24:34 1995 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-set-mode-line): Would bug out on nil max-lens. ! (gnus-summary-read-group): Did not properly configure windows on ! breaks. ! ! Wed Apr 26 19:48:36 1995 Scott Byer ! ! * gnus.el (gnus-group-get-new-news) Off by one with relation to ! the fix in gnus-get-unread-articles. ! ! Thu Apr 27 23:46:32 1995 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-next-article): Would bug out on nndigest ! groups. ! ! Thu Apr 27 13:45:21 1995 Scott Byer ! ! * nnfolder.el (nnfolder-request-group) Fixed it so it returns an ! active list even when the flag for not checking mail is t. ! ! * gnus.el (gnus-get-unread-articles) Changed comparison with level ! to < to fix fencepost error. Forced active to nil in the case ! where a foreign newsgroup shouldn't be activated. ! ! Wed Apr 26 19:48:36 1995 Scott Byer ! ! * nnfolder.el (nnfolder-request-group) Small performance tweak. ! ! * nnfolder.el (nnfolder-save-mail) Moved the code to kill previous ! newsgroups headers into the loop, affects mail saved to multiple ! folders so that they don't have multiple newsgroup markers ! anymore. ! ! * nnfolder.el (various) Made sure buffer needed saving before each ! request. ! ! Thu Apr 27 22:34:13 1995 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-parse-newsrc-body): Would reverse the list of ! groups if no .newsrc.eld file is present. ! (gnus-parse-newsrc-body): Would subscribe unsubscribed groups. ! (gnus-summary-mode-map): Many keymap changes. ! ! Thu Apr 27 21:45:05 1995 Lars Magne Ingebrigtsen ! ! * gnus-msg.el (gnus-inews-organization): Use the standard work ! buffer. ! (gnus-post-news): Did not use followup-to. ! ! Thu Apr 27 12:38:41 1995 Lars Magne Ingebrigtsen ! ! * gnus-kill.el (gnus-apply-kill-file-internal): Give abetter error ! massage on rn kill files. ! ! * gnus.el (gnus-article-de-quoted-unreadable): No interactive spec. ! ! Wed Apr 26 15:57:28 1995 Lars Magne Ingebrigtsen * gnus-message.el (gnus-inews-check-post): Would warn about too long lines when the last line didn't have a newline. * gnus-score.el (gnus-score-string): Would loop forever on empty matches. + + * gnus.el: 0.60 is released. Wed Apr 26 15:08:00 1995 Lars Magne Ingebrigtsen diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-kill.el dgnus/lisp/gnus-kill.el *** pub/dgnus/lisp/gnus-kill.el Wed Apr 26 17:03:52 1995 --- dgnus/lisp/gnus-kill.el Thu Apr 27 13:37:58 1995 *************** *** 372,377 **** --- 372,381 ---- (setq form (condition-case nil (read (current-buffer)) (error nil)))) + (or (listp form) + (error + "Illegal kill entry (possibly rn kill file?): %s" + form)) (if (or (eq (car form) 'gnus-kill) (eq (car form) 'gnus-raise) (eq (car form) 'gnus-lower)) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-message.el dgnus/lisp/gnus-message.el *** pub/dgnus/lisp/gnus-message.el Wed Apr 26 17:03:52 1995 --- dgnus/lisp/gnus-message.el Thu Apr 27 21:40:37 1995 *************** *** 1,1263 **** - ;;; gnus-message --- mail and post interface for Gnus - ;; Copyright (C) 1995 Free Software Foundation, Inc. - - ;; Author: Masanobu UMEDA - ;; Lars Magne Ingebrigtsen - ;; Keywords: news - - ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - - ;;; Commentary: - - ;;; Code: - - (require 'gnus) - (require 'sendmail) - - - ;;; - ;;; Gnus Posting Functions - ;;; - - (defvar gnus-organization-file "/usr/lib/news/organization" - "*Local news organization file.") - - (defvar gnus-post-news-buffer "*post-news*") - (defvar gnus-winconf-post-news nil) - - (defvar gnus-summary-send-map nil) - - (define-prefix-command 'gnus-summary-send-map) - (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) - (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) - (define-key gnus-summary-send-map "f" 'gnus-summary-followup) - (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) - (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) - (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) - (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) - (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) - (define-key gnus-summary-send-map "r" 'gnus-summary-reply) - (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) - (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) - (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) - (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) - (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) - (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) - (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) - - ;;; Post news commands of Gnus group mode and summary mode - - (defun gnus-group-post-news () - "Post an article." - (interactive) - (gnus-set-global-variables) - ;; Save window configuration. - (setq gnus-winconf-post-news (current-window-configuration)) - (let ((gnus-newsgroup-name nil)) - (unwind-protect - (if gnus-split-window - (progn - (pop-to-buffer gnus-article-buffer) - (widen) - (split-window-vertically) - (gnus-post-news 'post)) - (progn - (pop-to-buffer gnus-article-buffer) - (widen) - (delete-other-windows) - (gnus-post-news 'post))) - (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) - (not (zerop (buffer-size)))) - ;; Restore last window configuration. - (and gnus-winconf-post-news - (set-window-configuration gnus-winconf-post-news))))) - ;; We don't want to return to summary buffer nor article buffer later. - (setq gnus-winconf-post-news nil) - (if (get-buffer gnus-summary-buffer) - (bury-buffer gnus-summary-buffer)) - (if (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer))) - - (defun gnus-summary-post-news () - "Post an article." - (interactive) - (gnus-set-global-variables) - ;; Save window configuration. - (setq gnus-winconf-post-news (current-window-configuration)) - (unwind-protect - (gnus-post-news 'post gnus-newsgroup-name) - (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) - (not (zerop (buffer-size)))) - ;; Restore last window configuration. - (and gnus-winconf-post-news - (set-window-configuration gnus-winconf-post-news)))) - ;; We don't want to return to article buffer later. - (if (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer))) - - (defun gnus-summary-followup (yank) - "Compose a followup to an article. - If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive "P") - (gnus-set-global-variables) - (save-window-excursion - (gnus-summary-select-article t)) - (let ((headers gnus-current-headers) - (gnus-newsgroup-name gnus-newsgroup-name)) - ;; Check Followup-To: poster. - (set-buffer gnus-article-buffer) - (if (and gnus-use-followup-to - (string-equal "poster" (gnus-fetch-field "followup-to")) - (or (not (eq gnus-use-followup-to t)) - (not (gnus-y-or-n-p - "Do you want to ignore `Followup-To: poster'? ")))) - ;; Mail to the poster. Gnus is now RFC1036 compliant. - (gnus-summary-reply yank) - ;; Save window configuration. - (setq gnus-winconf-post-news (current-window-configuration)) - (unwind-protect - (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer yank) - (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) - (not (zerop (buffer-size)))) - ;; Restore last window configuration. - (and gnus-winconf-post-news - (set-window-configuration gnus-winconf-post-news)))) - ;; We don't want to return to article buffer later. - (bury-buffer gnus-article-buffer))) - (gnus-article-hide-headers-if-wanted)) - - (defun gnus-summary-followup-with-original () - "Compose a followup to an article and include the original article." - (interactive) - (gnus-summary-followup t)) - - ;; Suggested by Daniel Quinlan . - (defun gnus-summary-followup-and-reply (yank) - "Compose a followup and do an auto mail to author." - (interactive "P") - (let ((gnus-auto-mail-to-author t)) - (gnus-summary-followup yank))) - - (defun gnus-summary-followup-and-reply-with-original () - "Compose a followup, include the original, and do an auto mail to author." - (interactive) - (gnus-summary-followup-and-reply t)) - - (defun gnus-summary-cancel-article () - "Cancel an article you posted." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article t) - (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) - (gnus-article-hide-headers-if-wanted)) - - (defun gnus-summary-supersede-article () - "Compose an article that will supersede a previous article. - This is done simply by taking the old article and adding a Supersedes - header line with the old Message-ID." - (interactive) - (gnus-set-global-variables) - (if (not - (string-equal - (downcase (mail-strip-quoted-names - (header-from gnus-current-headers))) - (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) - (error "This article is not yours.")) - (gnus-summary-select-article t) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (if (not (re-search-backward "^Message-ID: " nil t)) - (error "No Message-ID in this article")))) - (if (gnus-post-news 'post gnus-newsgroup-name) - (progn - (erase-buffer) - (insert-buffer gnus-article-buffer) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (if (not (re-search-backward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (search-forward "\n\n") - (forward-line -1) - (insert mail-header-separator)))) - - - ;;;###autoload - (fset 'sendnews 'gnus-post-news) - - ;;;###autoload - (fset 'postnews 'gnus-post-news) - - (defun gnus-post-news (post &optional group header article-buffer yank subject) - "Begin editing a new USENET news article to be posted. - Type \\[describe-mode] in the buffer to get a list of commands." - (interactive (list t)) - (if (or (not gnus-novice-user) - gnus-expert-user - (not (eq 'post - (nth 1 (assoc - (format "%s" (car (gnus-find-method-for-group - gnus-newsgroup-name))) - gnus-valid-select-methods)))) - (and group - (assq 'to-address - (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))) - (gnus-y-or-n-p "Are you sure you want to post to all of USENET? ")) - (let ((sumart (if (not post) - (save-excursion - (set-buffer gnus-summary-buffer) - (cons (current-buffer) gnus-current-article)))) - (from (and header (header-from header))) - follow-to real-group) - (and gnus-interactive-post - (not gnus-expert-user) - post (not group) - (progn - (setq group - (completing-read "Group: " gnus-active-hashtb)) - (or subject - (setq subject (read-string "Subject: "))))) - (setq mail-reply-buffer article-buffer) - - (let ((gnus-newsgroup-name (or group gnus-newsgroup-name ""))) - (setq real-group (and group (gnus-group-real-name group))) - (setq gnus-post-news-buffer - (gnus-request-post-buffer - post real-group subject header article-buffer - (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb))) - (or (cdr (assq 'to-group - (nth 5 (nth 2 (gnus-gethash - gnus-newsgroup-name - gnus-newsrc-hashtb))))) - (if (and (boundp 'gnus-followup-to-function) - gnus-followup-to-function - article-buffer) - (setq follow-to - (save-excursion - (set-buffer article-buffer) - (funcall gnus-followup-to-function group))))) - (eq gnus-use-followup-to t))) - (if post - (progn - (gnus-configure-windows '(1 0 0)) - (switch-to-buffer gnus-post-news-buffer)) - (gnus-configure-windows '(0 1 0)) - (if (not yank) - (progn - (switch-to-buffer article-buffer) - (pop-to-buffer gnus-post-news-buffer)) - (switch-to-buffer gnus-post-news-buffer))) - (gnus-overload-functions) - (make-local-variable 'gnus-article-reply) - (make-local-variable 'gnus-article-check-size) - (setq gnus-article-reply sumart) - ;; Handle `gnus-auto-mail-to-author'. - ;; Suggested by Daniel Quinlan . - (let ((to (if (eq gnus-auto-mail-to-author 'ask) - (and (y-or-n-p "Also send mail to author? ") from) - (and gnus-auto-mail-to-author from)))) - (if to - (progn - (if (mail-fetch-field "To") - (progn - (beginning-of-line) - (insert "Cc: " to "\n")) - (mail-position-on-field "To") - (insert to))))) - ;; Handle author copy using BCC field. - (if (and gnus-mail-self-blind - (not (mail-fetch-field "bcc"))) - (progn - (mail-position-on-field "Bcc") - (insert (if (stringp gnus-mail-self-blind) - gnus-mail-self-blind - (user-login-name))))) - ;; Handle author copy using FCC field. - (if gnus-author-copy - (progn - (mail-position-on-field "Fcc") - (insert gnus-author-copy))) - (goto-char (point-min)) - (if post - (cond ((not group) - (re-search-forward "^Newsgroup:" nil t) - (end-of-line)) - ((not subject) - (re-search-forward "^Subject:" nil t) - (end-of-line)) - (t - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1))) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (and yank (save-excursion (news-reply-yank-original nil))) - (if gnus-post-prepare-function - (funcall gnus-post-prepare-function group)))))) - (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) - (message "") - t) - - (defun gnus-inews-news (&optional use-group-method) - "Send a news message. - If given a prefix, and the group is a foreign group, this function - will attempt to use the foreign server to post the article." - (interactive "P") - ;; Check whether the article is a good Net Citizen. - (if (and gnus-article-check-size (not (gnus-inews-check-post))) - ;; Aber nein! - () - ;; Looks ok, so we do the nasty. - (let* ((case-fold-search nil) - (server-running (gnus-server-opened gnus-select-method)) - (reply gnus-article-reply)) - (save-excursion - ;; Connect to default NNTP server if necessary. - ;; Suggested by yuki@flab.fujitsu.junet. - (gnus-start-news-server) ;Use default server. - ;; NNTP server must be opened before current buffer is modified. - (widen) - (goto-char (point-min)) - (run-hooks 'news-inews-hook) - (save-restriction - (narrow-to-region - (point-min) - (progn - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")))) - - ;; Correct newsgroups field: change sequence of spaces to comma and - ;; eliminate spaces around commas. Eliminate imbedded line breaks. - (goto-char (point-min)) - (if (search-forward-regexp "^Newsgroups: +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil 'end) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) - (goto-char (point-min)) - (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) - - ;; Added by Per Abrahamsen . - ;; Help save the the world! - (or - gnus-expert-user - (let ((newsgroups (mail-fetch-field "newsgroups")) - (followup-to (mail-fetch-field "followup-to")) - groups to) - (if (and (string-match "," newsgroups) (not followup-to)) - (progn - (while (string-match "," newsgroups) - (setq groups - (cons (list (substring newsgroups - 0 (match-beginning 0))) - groups)) - (setq newsgroups (substring newsgroups (match-end 0)))) - (setq groups (nreverse (cons (list newsgroups) groups))) - - (setq to - (completing-read "Followups to: (default all groups) " - groups)) - (if (> (length to) 0) - (progn - (goto-char (point-min)) - (insert "Followup-To: " to "\n"))))))) - - ;; Cleanup Followup-To. - (goto-char (point-min)) - (if (search-forward-regexp "^Followup-To: +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil 'end) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) - (goto-char (point-min)) - (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) - - ;; Mail the message too if To:, Bcc:. or Cc: exists. - (if (or (mail-fetch-field "to" nil t) - (mail-fetch-field "bcc" nil t) - (mail-fetch-field "cc" nil t)) - (if gnus-mail-send-method - (save-excursion - (save-restriction - (widen) - (message "Sending via mail...") - - (if gnus-mail-courtesy-message - (progn - ;; Insert "courtesy" mail message. - (goto-char 1) - (re-search-forward - (concat "^" (regexp-quote - mail-header-separator) "$")) - (forward-line 1) - (insert gnus-mail-courtesy-message) - (funcall gnus-mail-send-method) - (goto-char 1) - (search-forward gnus-mail-courtesy-message) - (replace-match "" t t)) - (funcall gnus-mail-send-method)) - - (message "Sending via mail... done") - - (goto-char 1) - (narrow-to-region - 1 (re-search-forward - (concat "^" (regexp-quote - mail-header-separator) "$"))) - (goto-char 1) - (delete-matching-lines "BCC:.*"))) - (ding) - (message "No mailer defined. To: and/or Cc: fields ignored.") - (sit-for 1)))) - - ;; Send to NNTP server. - (message "Posting to USENET...") - (if (gnus-inews-article use-group-method) - (progn - (message "Posting to USENET... done") - (if (gnus-buffer-exists-p (car-safe reply)) - (progn - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-mark-article-as-replied - (cdr reply)))))) - ;; We cannot signal an error. - (ding) (message "Article rejected: %s" - (gnus-status-message gnus-select-method))) - (set-buffer-modified-p nil)) - ;; If NNTP server is opened by gnus-inews-news, close it by myself. - (or server-running - (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) - (and (fboundp 'bury-buffer) (bury-buffer)) - ;; Restore last window configuration. - (and gnus-winconf-post-news - (set-window-configuration gnus-winconf-post-news)) - (setq gnus-winconf-post-news nil)))) - - (defun gnus-inews-check-post () - "Check whether the post looks ok." - (or - (not gnus-check-before-posting) - (and - ;; We narrow to the headers and check them first. - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$"))) - (goto-char (point-min)) - (and - ;; Check for commands in Subject. - (save-excursion - (if (string-match "^cmsg " (mail-fetch-field "subject")) - (gnus-y-or-n-p - "The control code \"cmsg \" is in the subject. Really post? ") - t)) - ;; Check for multiple identical headers. - (save-excursion - (let (found) - (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) - (save-excursion - (or (re-search-forward - (concat "^" (setq found - (buffer-substring - (match-beginning 0) - (- (match-end 0) 2)))) - nil t) - (setq found nil)))) - (if found - (gnus-y-or-n-p - (format "Multiple %s headers. Really post? " found)) - t))) - ;; Check for version and sendsys. - (save-excursion - (if (re-search-forward "^Sendsys:\\|^Version:" nil t) - (gnus-yes-or-no-p - (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) - (1- (match-end 0))))) - t)) - ;; Check the Message-Id header. - (save-excursion - (let* ((case-fold-search t) - (message-id (mail-fetch-field "message-id"))) - (or (not message-id) - (and (string-match "@" message-id) - (string-match "@[^\\.]*\\." message-id)) - (gnus-yes-or-no-p - (format "The Message-ID looks strange: \"%s\". Really post? " - message-id))))) - ;; Check the From header. - (save-excursion - (let* ((case-fold-search t) - (from (mail-fetch-field "from"))) - (or (not from) - (and (string-match "@" from) - (string-match "@[^\\.]*\\." from)) - (gnus-yes-or-no-p - (format "The From looks strange: \"%s\". Really post? " - from)))))))) - ;; Check for long lines. - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (and - (progn - (end-of-line) - (< (current-column) 80)) - (zerop (forward-line 1)))) - (or (bolp) - (eobp) - (gnus-yes-or-no-p - (format - "You have lines longer than 79 characters. Really post? ")))) - ;; Check for control characters. - (save-excursion - (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) - (gnus-y-or-n-p - "The article contains control characters. Really post? ") - t)) - ;; Check excessive size. - (if (> (buffer-size) 60000) - (gnus-y-or-n-p (format "The article is %d octets long. Really post? " - (buffer-size))) - t) - ;; Use the (size . checksum) variable to see whether the - ;; article is empty or has only quoted text. - (if (and (= (buffer-size) (car gnus-article-check-size)) - (= (gnus-article-checksum) (cdr gnus-article-check-size))) - (gnus-yes-or-no-p - "It looks like there's no new text in your article. Really post? ") - t)))) - - (defun gnus-article-checksum () - (let ((sum 0)) - (save-excursion - (while (not (eobp)) - (setq sum (logxor sum (following-char))) - (forward-char 1))) - sum)) - - (defun gnus-cancel-news () - "Cancel an article you posted." - (interactive) - (if (or gnus-expert-user - (gnus-yes-or-no-p "Do you really want to cancel this article? ")) - (let ((from nil) - (newsgroups nil) - (message-id nil) - (distribution nil)) - (save-excursion - ;; Get header info. from original article. - (save-restriction - (gnus-article-show-all-headers) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (narrow-to-region (point-min) (point)) - (setq from (mail-fetch-field "from")) - (setq newsgroups (mail-fetch-field "newsgroups")) - (setq message-id (mail-fetch-field "message-id")) - (setq distribution (mail-fetch-field "distribution"))) - ;; Verify if the article is absolutely user's by comparing - ;; user id with value of its From: field. - (if (not - (string-equal - (downcase (mail-strip-quoted-names from)) - (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) - (progn - (ding) (message "This article is not yours.")) - ;; Make control article. - (set-buffer (get-buffer-create " *Gnus-canceling*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "Subject: cancel " message-id "\n" - "Control: cancel " message-id "\n" - mail-header-separator "\n" - "This is a cancel message from " from ".\n") - ;; Send the control article to NNTP server. - (message "Canceling your article...") - (if (gnus-inews-article) - (message "Canceling your article... done") - (ding) - (message "Cancel failed; %s" - (gnus-status-message gnus-newsgroup-name))) - ;; Kill the article buffer. - (kill-buffer (current-buffer))))))) - - - ;;; Lowlevel inews interface - - (defun gnus-inews-article (&optional use-group-method) - "Post an article in current buffer using NNTP protocol." - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-posting*"))) - (widen) - (goto-char (point-max)) - ;; require a newline at the end for inews to append .signature to - (or (= (preceding-char) ?\n) - (insert ?\n)) - ;; Prepare article headers. All message body such as signature - ;; must be inserted before Lines: field is prepared. - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point-min) - (save-excursion - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (gnus-inews-remove-headers) - (gnus-inews-insert-headers) - (run-hooks gnus-inews-article-header-hook) - (widen)) - (save-excursion - (set-buffer tmpbuf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring artbuf) - ;; Remove the header separator. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; This hook may insert a signature. - (run-hooks 'gnus-prepare-article-hook) - ;; Run final inews hooks. This hook may do FCC. - ;; The article must be saved before being posted because - ;; `gnus-request-post' modifies the buffer. - (run-hooks 'gnus-inews-article-hook) - ;; Post an article to NNTP server. - ;; Return NIL if post failed. - (prog1 - (gnus-request-post - (if use-group-method - (gnus-find-method-for-group gnus-newsgroup-name) - gnus-select-method) use-group-method) - (kill-buffer (current-buffer)))))) - - (defun gnus-inews-remove-headers () - (let ((case-fold-search t)) - ;; Remove NNTP-posting-host. - (goto-char (point-min)) - (and (re-search-forward "^nntp-posting-host:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Remove Bcc. - (goto-char (point-min)) - (and (re-search-forward "^bcc:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))))) - - (defun gnus-inews-insert-headers () - "Prepare article headers. - Headers already prepared in the buffer are not modified. - Headers in `gnus-required-headers' will be generated." - (let ((Date (gnus-inews-date)) - (Message-ID (gnus-inews-message-id)) - (Organization (gnus-inews-organization)) - (From (gnus-inews-user-name)) - (Path (gnus-inews-path)) - (Subject nil) - (Newsgroups nil) - (Distribution nil) - (Lines (gnus-inews-lines)) - (X-Newsreader gnus-version) - (headers gnus-required-headers) - (case-fold-search t) - header value elem) - ;; First we remove any old Message-IDs. This might be slightly - ;; fascist, but if the user really wants to generate Message-IDs - ;; by herself, she should remove it from the `gnus-required-list'. - (goto-char (point-min)) - (and (memq 'Message-ID headers) - (re-search-forward "^Message-ID:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Insert new Sender if the From is strange. - (let ((from (mail-fetch-field "from"))) - (if (and from (not (string= (downcase from) (downcase From)))) - (progn - (goto-char (point-min)) - (and (re-search-forward "^Sender:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (insert "Sender: " From "\n")))) - ;; If there are References, and no "Re: ", then the thread has - ;; changed name. See Son-of-1036. - (if (and (mail-fetch-field "references") - (get-buffer gnus-article-buffer)) - (let ((psubject (gnus-simplify-subject-re - (mail-fetch-field "subject"))) - subject) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (gnus-narrow-to-headers) - (if (setq subject (mail-fetch-field "subject")) - (progn - (and gnus-summary-gather-subject-limit - (numberp gnus-summary-gather-subject-limit) - (> (length subject) gnus-summary-gather-subject-limit) - (setq subject - (substring subject 0 - gnus-summary-gather-subject-limit))) - (setq subject (gnus-simplify-subject-re subject)))))) - (or (and psubject subject (string= subject psubject)) - (progn - (string-match "@" Message-ID) - (setq Message-ID - (concat (substring Message-ID 0 (match-beginning 0)) - "_-_" - (substring Message-ID (match-beginning 0)))))))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (car headers)) - (if (consp elem) - (setq header (car elem)) - (setq header elem)) - (if (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") nil t)) - (progn - (if (= (following-char) ? ) (forward-char 1) (insert " ")) - (looking-at "[ \t]*$"))) - (progn - (setq value - (or (if (consp elem) - ;; The element is a cons. Either the cdr is - ;; a string to be inserted verbatim, or it - ;; is a function, and we insert the value - ;; returned from this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem)))) - ;; The element is a symbol. We insert the - ;; value of this symbol, if any. - (and (boundp header) (symbol-value header))) - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header)))) - (if (bolp) - (save-excursion - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n")) - (replace-match value t t)))) - (setq headers (cdr headers))))) - - (defun gnus-inews-insert-signature () - "Insert a signature file. - If `gnus-signature-function' is bound and returns a string, this - string is used instead of the variable `gnus-signature-file'. - In either case, if the string is a file name, this file is - inserted. If the string is not a file name, the string itself is - inserted. - If you never want any signature inserted, set both those variables to - nil." - (save-excursion - (let ((signature - (or (and gnus-signature-function - (fboundp gnus-signature-function) - (funcall gnus-signature-function gnus-newsgroup-name)) - gnus-signature-file)) - b) - (if (and signature - (or (file-exists-p signature) - (string-match " " signature) - (not (string-match - "^/[^/]+/" (expand-file-name signature))))) - (progn - (goto-char (point-max)) - ;; Delete any previous signatures. - (if (and mail-signature (search-backward "\n-- \n" nil t)) - (delete-region (1+ (point)) (point-max))) - (insert "\n-- \n") - (and (< 4 (setq b (count-lines - (point) - (progn - (if (file-exists-p signature) - (insert-file-contents signature) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (point))))) - (not gnus-expert-user) - (not - (gnus-y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - b))) - (if (file-exists-p signature) - (error (format "Edit %s." signature)) - (error "Trim your signature.")))))))) - - (defun gnus-inews-do-fcc () - "Process FCC: fields in current article buffer. - Unless the first character of the field is `|', the article is saved - to the specified file using the function specified by the variable - gnus-author-copy-saver. The default function rmail-output saves in - Unix mailbox format. - If the first character is `|', the contents of the article is send to - a program specified by the rest of the value." - (let ((fcc-list nil) - (fcc-file nil) - (case-fold-search t)) ;Should ignore case. - (save-excursion - (save-restriction - (goto-char (point-min)) - (search-forward "\n\n") - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (re-search-forward "^FCC:[ \t]*" nil t) - (setq fcc-list - (cons (buffer-substring - (point) - (progn - (end-of-line) - (skip-chars-backward " \t") - (point))) - fcc-list)) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - ;; Process FCC operations. - (widen) - (while fcc-list - (setq fcc-file (car fcc-list)) - (setq fcc-list (cdr fcc-list)) - (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) - (let ((program (substring fcc-file - (match-beginning 1) (match-end 1)))) - ;; Suggested by yuki@flab.fujitsu.junet. - ;; Send article to named program. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil "-c" program))) - (t - ;; Suggested by hyoko@flab.fujitsu.junet. - ;; Save article in Unix mail format by default. - (if (and gnus-author-copy-saver - (not (eq gnus-author-copy-saver 'rmail-output))) - (funcall gnus-author-copy-saver fcc-file) - (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file)) - (gnus-output-to-rmail fcc-file) - (rmail-output fcc-file 1 t t)))))))))) - - (defun gnus-inews-path () - "Return uucp path." - (let ((login-name (gnus-inews-login-name))) - (cond ((null gnus-use-generic-path) - (concat (nth 1 gnus-select-method) "!" login-name)) - ((stringp gnus-use-generic-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat gnus-use-generic-path "!" login-name)) - (t login-name)))) - - (defun gnus-inews-user-name () - "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." - (let ((full-name (gnus-inews-full-name))) - (or gnus-user-from-line - (concat (if (or gnus-user-login-name gnus-use-generic-from - gnus-local-domain (getenv "DOMAINNAME")) - (concat (gnus-inews-login-name) "@" - (gnus-inews-domain-name gnus-use-generic-from)) - user-mail-address) - ;; User's full name. - (cond ((string-equal full-name "") "") - ((string-equal full-name "&") ;Unix hack. - (concat " (" (user-login-name) ")")) - (t - (concat " (" full-name ")"))))))) - - (defun gnus-inews-login-name () - "Return login name." - (or gnus-user-login-name (getenv "LOGNAME") (user-login-name))) - - (defun gnus-inews-full-name () - "Return full user name." - (or gnus-user-full-name (getenv "NAME") (user-full-name))) - - (defun gnus-inews-domain-name (&optional genericfrom) - "Return user's domain name. - If optional argument GENERICFROM is a string, use it as the domain - name; if it is non-nil, strip off local host name from the domain name. - If the function `system-name' returns full internet name and the - domain is undefined, the domain name is got from it." - (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) - (let* ((system-name (system-name)) - (domain - (or (if (stringp genericfrom) genericfrom) - (getenv "DOMAINNAME") - gnus-local-domain - ;; Function `system-name' may return full internet name. - ;; Suggested by Mike DeCorte . - (if (string-match "\\." system-name) - (substring system-name (match-end 0))) - (read-string "Domain name (no host): "))) - (host (or (if (string-match "\\." system-name) - (substring system-name 0 (match-beginning 0))) - system-name))) - (if (string-equal "." (substring domain 0 1)) - (setq domain (substring domain 1))) - ;; Support GENERICFROM as same as standard Bnews system. - ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. - (cond ((null genericfrom) - (concat host "." domain)) - ;;((stringp genericfrom) genericfrom) - (t domain))) - (if (string-match "\\." (system-name)) - (system-name) - (substring user-mail-address - (1+ (string-match "@" user-mail-address)))))) - - (defun gnus-inews-full-address () - (let ((domain (gnus-inews-domain-name)) - (system (system-name)) - (case-fold-search t)) - (if (string-match "\\." system) system - (if (string-match (concat "^" (regexp-quote system)) domain) domain - (concat system "." domain))))) - - (defun gnus-inews-message-id () - "Generate unique Message-ID for user." - ;; Message-ID should not contain a slash and should be terminated by - ;; a number. I don't know the reason why it is so. - (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">")) - - (defun gnus-inews-unique-id () - "Generate unique ID from user name and current time." - (concat (downcase (gnus-inews-login-name)) - (mapconcat - (lambda (num) (gnus-number-base-x num 3 31)) - (current-time) ""))) - - (defun gnus-inews-date () - "Current time string." - (timezone-make-date-arpa-standard - (current-time-string) (current-time-zone))) - - (defun gnus-inews-organization () - "Return user's organization. - The ORGANIZATION environment variable is used if defined. - If not, the variable `gnus-local-organization' is used instead. - If it is a function, the function will be called with the current - newsgroup name as the argument. - If this is a file name, the contents of this file will be used as the - organization." - (let* ((organization - (or (getenv "ORGANIZATION") - (if gnus-local-organization - (if (and (symbolp gnus-local-organization) - (fboundp gnus-local-organization)) - (funcall gnus-local-organization gnus-newsgroup-name) - gnus-local-organization)) - gnus-organization-file - "~/.organization"))) - (and (stringp organization) - (> (length organization) 0) - (or (file-exists-p organization) - (string-match " " organization) - (not (string-match "^/[^/]+/" (expand-file-name organization)))) - (save-excursion - (set-buffer (get-buffer-create " *Gnus organization*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (if (file-exists-p organization) - (insert-file-contents organization) - (insert organization)) - (goto-char (point-min)) - (while (re-search-forward " *\n *" nil t) - (replace-match " " t t)) - (buffer-substring (point-min) (point-max)))))) - - (defun gnus-inews-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - - - ;;; - ;;; Gnus Mail Functions - ;;; - - ;;; Mail reply commands of Gnus summary mode - - (defun gnus-summary-reply (yank) - "Reply mail to news author. - If prefix argument YANK is non-nil, original article is yanked automatically. - Customize the variable gnus-mail-reply-method to use another mailer." - (interactive "P") - ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (gnus-set-global-variables) - (setq gnus-winconf-post-news (current-window-configuration)) - (gnus-summary-select-article t) - (let ((gnus-newsgroup-name gnus-newsgroup-name)) - (bury-buffer gnus-article-buffer) - (funcall gnus-mail-reply-method yank)) - (gnus-article-hide-headers-if-wanted)) - - (defun gnus-summary-reply-with-original () - "Reply mail to news author with original article. - Customize the variable gnus-mail-reply-method to use another mailer." - (interactive) - (gnus-summary-reply t)) - - (defun gnus-summary-mail-forward (post) - "Forward the current message to another user. - Customize the variable gnus-mail-forward-method to use another mailer." - (interactive "P") - (gnus-summary-select-article t) - (setq gnus-winconf-post-news (current-window-configuration)) - (if gnus-split-window - (widen) - (switch-to-buffer gnus-article-buffer) - (widen) - (delete-other-windows) - (bury-buffer gnus-article-buffer)) - (let ((gnus-newsgroup-name gnus-newsgroup-name)) - (if post - (gnus-forward-using-post) - (funcall gnus-mail-forward-method))) - (gnus-article-hide-headers-if-wanted)) - - (defun gnus-summary-post-forward () - "Forward the current article to a newsgroup." - (interactive) - (gnus-summary-mail-forward t)) - - (defun gnus-summary-mail-other-window () - "Compose mail in other window. - Customize the variable `gnus-mail-other-window-method' to use another - mailer." - (interactive) - (setq gnus-winconf-post-news (current-window-configuration)) - (let ((gnus-newsgroup-name gnus-newsgroup-name)) - (funcall gnus-mail-other-window-method))) - - (defun gnus-mail-reply-using-mail (&optional yank to-address) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) - (group (gnus-group-real-name gnus-newsgroup-name)) - (cur (cons (current-buffer) (cdr gnus-article-current))) - from subject date to reply-to message-of - references message-id sender follow-to cc sendto elt) - (set-buffer (get-buffer-create "*mail*")) - (mail-mode) - (make-local-variable 'gnus-article-reply) - (setq gnus-article-reply cur) - (use-local-map (copy-keymap mail-mode-map)) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) - (if (and (buffer-modified-p) - (> (buffer-size) 0) - (not (gnus-y-or-n-p - "Unsent article being composed; erase it? "))) - () - (erase-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (narrow-to-region (point-min) - (progn (search-forward "\n\n") (point))) - (add-text-properties (point-min) (point-max) '(invisible nil))) - (if (and (boundp 'gnus-reply-to-function) - gnus-reply-to-function) - (save-excursion - (save-restriction - (gnus-narrow-to-headers) - (setq follow-to (funcall gnus-reply-to-function group))))) - (setq from (mail-fetch-field "from")) - (setq date (mail-fetch-field "date")) - (and from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (setq message-of - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " date)))) - (setq sender (mail-fetch-field "sender")) - (setq subject (or (mail-fetch-field "subject") - "Re: none")) - (or (string-match "^[Rr][Ee]:" subject) - (setq subject (concat "Re: " subject))) - (setq cc (mail-fetch-field "cc")) - (setq reply-to (mail-fetch-field "reply-to")) - (setq references (mail-fetch-field "references")) - (setq message-id (mail-fetch-field "message-id")) - (widen)) - (setq news-reply-yank-from from) - (setq news-reply-yank-message-id message-id) - - ;; Gather the "to" addresses out of the follow-to list and remove - ;; them as we go. - (if (and follow-to (listp follow-to)) - (while (setq elt (assoc "To" follow-to)) - (setq sendto (concat sendto (and sendto ", ") (cdr elt))) - (setq follow-to (delq elt follow-to)))) - - (mail-setup (or to-address - (if (and follow-to (not (stringp follow-to))) sendto - (or follow-to reply-to from sender ""))) - subject message-of nil gnus-article-buffer nil) - - (if (and follow-to (listp follow-to)) - (progn - (goto-char (point-min)) - (re-search-forward "^To:" nil t) - (beginning-of-line) - (forward-line 1) - (while follow-to - (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") - (setq follow-to (cdr follow-to))))) - ;; Fold long references line to follow RFC1036. - (mail-position-on-field "References") - (let ((begin (- (point) (length "References: "))) - (fill-column 78) - (fill-prefix "\t")) - (if references (insert references)) - (if (and references message-id) (insert " ")) - (if message-id (insert message-id)) - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (if yank - (let ((last (point))) - (save-excursion - (mail-yank-original nil)) - (run-hooks 'news-reply-header-hook) - (goto-char last)))) - (let ((mail (current-buffer))) - (if yank - (progn - (gnus-configure-windows '(0 1 0)) - (switch-to-buffer mail)) - (gnus-configure-windows '(0 0 1)) - (switch-to-buffer-other-window mail)))))) - - (defun gnus-mail-yank-original () - (interactive) - (save-excursion - (mail-yank-original nil)) - (run-hooks 'news-reply-header-hook)) - - (defun gnus-mail-send-and-exit () - (interactive) - (let ((cbuf (current-buffer))) - (mail-send-and-exit nil) - (if (get-buffer gnus-group-buffer) - (progn - (save-excursion - (set-buffer cbuf) - (let ((reply gnus-article-reply)) - (if (gnus-buffer-exists-p (car-safe reply)) - (progn - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply))))))) - (and gnus-winconf-post-news - (set-window-configuration gnus-winconf-post-news)) - (setq gnus-winconf-post-news nil))))) - - (defun gnus-forward-make-subject () - (concat "[" (if (memq 'mail (assoc (symbol-name - (car (gnus-find-method-for-group - gnus-newsgroup-name))) - gnus-valid-select-methods)) - (gnus-fetch-field "From") - gnus-newsgroup-name) - "] " (or (gnus-fetch-field "Subject") ""))) - - (defun gnus-forward-insert-buffer (buffer) - (let ((beg (goto-char (point-max)))) - (insert "------- Start of forwarded message -------\n") - (insert-buffer buffer) - (goto-char (point-max)) - (insert "------- End of forwarded message -------\n") - ;; Suggested by Sudish Joseph . - (goto-char beg) - (while (setq beg (next-single-property-change (point) 'invisible)) - (goto-char beg) - (delete-region beg (or (next-single-property-change - (point) 'invisible) - (point-max)))))) - - (defun gnus-mail-forward-using-mail () - "Forward the current message to another user using mail." - ;; This is almost a carbon copy of rmail-forward in rmail.el. - (let ((forward-buffer (current-buffer)) - (subject (gnus-forward-make-subject))) - ;; If only one window, use it for the mail buffer. Otherwise, use - ;; another window for the mail buffer so that the Rmail buffer - ;; remains visible and sending the mail will get back to it. - (if (if (one-window-p t) - (mail nil nil subject) - (mail-other-window nil nil subject)) - (save-excursion - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) - (gnus-forward-insert-buffer forward-buffer) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook))))) - - (defun gnus-forward-using-post () - (let ((forward-buffer (current-buffer)) - (subject (gnus-forward-make-subject))) - (gnus-post-news 'post nil nil nil nil subject) - (save-excursion - (gnus-forward-insert-buffer forward-buffer) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook)))) - - (defun gnus-mail-other-window-using-mail () - "Compose mail other window using mail." - (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)) - - (provide 'gnus-message) - - ;;; gnus-message.el ends here --- 0 ---- diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-msg.el dgnus/lisp/gnus-msg.el *** pub/dgnus/lisp/gnus-msg.el Thu Apr 27 21:41:18 1995 --- dgnus/lisp/gnus-msg.el Thu Apr 27 23:52:33 1995 *************** *** 0 **** --- 1,1311 ---- + ;;; gnus-message --- mail and post interface for Gnus + ;; Copyright (C) 1995 Free Software Foundation, Inc. + + ;; Author: Masanobu UMEDA + ;; Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (require 'sendmail) + + + ;;; + ;;; Gnus Posting Functions + ;;; + + (defvar gnus-organization-file "/usr/lib/news/organization" + "*Local news organization file.") + + (defvar gnus-post-news-buffer "*post-news*") + (defvar gnus-winconf-post-news nil) + + (defvar gnus-summary-send-map nil) + + (define-prefix-command 'gnus-summary-send-map) + (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) + (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) + (define-key gnus-summary-send-map "f" 'gnus-summary-followup) + (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) + (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) + (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) + (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) + (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) + (define-key gnus-summary-send-map "r" 'gnus-summary-reply) + (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) + (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) + (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) + (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) + (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) + (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) + (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) + + ;;; Internal functions. + + ;; Return NUM konverted to a key of exactly LEN chars. Requires NUM>=0. + ;; If LEN=-1, return 0 or more chars as necessary. + (defun gnus-number-base31 (num len) + (if (if (< len 0) (<= num 0) (= len 0)) + "" + (concat (gnus-number-base31 (/ num 31) (1- len)) + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" + (% num 31)))))) + + (defun gnus-number-base36 (num len) + (if (if (< len 0) (<= num 0) (= len 0)) + "" + (concat (gnus-number-base36 (/ num 36) (1- len)) + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" + (% num 36)))))) + + ;;; Post news commands of Gnus group mode and summary mode + + (defun gnus-group-post-news () + "Post an article." + (interactive) + (gnus-set-global-variables) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + (let ((gnus-newsgroup-name nil)) + (unwind-protect + (if gnus-split-window + (progn + (pop-to-buffer gnus-article-buffer) + (widen) + (split-window-vertically) + (gnus-post-news 'post)) + (progn + (pop-to-buffer gnus-article-buffer) + (widen) + (delete-other-windows) + (gnus-post-news 'post))) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news))))) + ;; We don't want to return to summary buffer nor article buffer later. + (setq gnus-winconf-post-news nil) + (if (get-buffer gnus-summary-buffer) + (bury-buffer gnus-summary-buffer)) + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer))) + + (defun gnus-summary-post-news () + "Post an article." + (interactive) + (gnus-set-global-variables) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + (unwind-protect + (gnus-post-news 'post gnus-newsgroup-name) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news)))) + ;; We don't want to return to article buffer later. + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer))) + + (defun gnus-summary-followup (yank) + "Compose a followup to an article. + If prefix argument YANK is non-nil, original article is yanked automatically." + (interactive "P") + (gnus-set-global-variables) + (save-window-excursion + (gnus-summary-select-article t)) + (let ((headers gnus-current-headers) + (gnus-newsgroup-name gnus-newsgroup-name)) + ;; Check Followup-To: poster. + (set-buffer gnus-article-buffer) + (if (and gnus-use-followup-to + (string-equal "poster" (gnus-fetch-field "followup-to")) + (or (not (eq gnus-use-followup-to t)) + (not (gnus-y-or-n-p + "Do you want to ignore `Followup-To: poster'? ")))) + ;; Mail to the poster. Gnus is now RFC1036 compliant. + (gnus-summary-reply yank) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + (unwind-protect + (gnus-post-news nil gnus-newsgroup-name + headers gnus-article-buffer yank) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news)))) + ;; We don't want to return to article buffer later. + (bury-buffer gnus-article-buffer))) + (gnus-article-hide-headers-if-wanted)) + + (defun gnus-summary-followup-with-original () + "Compose a followup to an article and include the original article." + (interactive) + (gnus-summary-followup t)) + + ;; Suggested by Daniel Quinlan . + (defun gnus-summary-followup-and-reply (yank) + "Compose a followup and do an auto mail to author." + (interactive "P") + (let ((gnus-auto-mail-to-author t)) + (gnus-summary-followup yank))) + + (defun gnus-summary-followup-and-reply-with-original () + "Compose a followup, include the original, and do an auto mail to author." + (interactive) + (gnus-summary-followup-and-reply t)) + + (defun gnus-summary-cancel-article () + "Cancel an article you posted." + (interactive) + (gnus-set-global-variables) + (gnus-summary-select-article t) + (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) + (gnus-article-hide-headers-if-wanted)) + + (defun gnus-summary-supersede-article () + "Compose an article that will supersede a previous article. + This is done simply by taking the old article and adding a Supersedes + header line with the old Message-ID." + (interactive) + (gnus-set-global-variables) + (if (not + (string-equal + (downcase (mail-strip-quoted-names + (header-from gnus-current-headers))) + (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) + (error "This article is not yours.")) + (gnus-summary-select-article t) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (if (not (re-search-backward "^Message-ID: " nil t)) + (error "No Message-ID in this article")))) + (if (gnus-post-news 'post gnus-newsgroup-name) + (progn + (erase-buffer) + (insert-buffer gnus-article-buffer) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (if (not (re-search-backward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: " t t)) + (search-forward "\n\n") + (forward-line -1) + (insert mail-header-separator)))) + + + ;;;###autoload + (fset 'sendnews 'gnus-post-news) + + ;;;###autoload + (fset 'postnews 'gnus-post-news) + + (defun gnus-post-news (post &optional group header article-buffer yank subject) + "Begin editing a new USENET news article to be posted. + Type \\[describe-mode] in the buffer to get a list of commands." + (interactive (list t)) + (if (or (not gnus-novice-user) + gnus-expert-user + (not (eq 'post + (nth 1 (assoc + (format "%s" (car (gnus-find-method-for-group + gnus-newsgroup-name))) + gnus-valid-select-methods)))) + (and group + (assq 'to-address + (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))) + (gnus-y-or-n-p "Are you sure you want to post to all of USENET? ")) + (let ((sumart (if (not post) + (save-excursion + (set-buffer gnus-summary-buffer) + (cons (current-buffer) gnus-current-article)))) + (from (and header (header-from header))) + follow-to real-group) + (and gnus-interactive-post + (not gnus-expert-user) + post (not group) + (progn + (setq group + (completing-read "Group: " gnus-active-hashtb)) + (or subject + (setq subject (read-string "Subject: "))))) + (setq mail-reply-buffer article-buffer) + + (let ((gnus-newsgroup-name (or group gnus-newsgroup-name ""))) + (setq real-group (and group (gnus-group-real-name group))) + (setq gnus-post-news-buffer + (gnus-request-post-buffer + post real-group subject header article-buffer + (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb))) + (or (cdr (assq 'to-group + (nth 5 (nth 2 (gnus-gethash + gnus-newsgroup-name + gnus-newsrc-hashtb))))) + (if (and (boundp 'gnus-followup-to-function) + gnus-followup-to-function + article-buffer) + (setq follow-to + (save-excursion + (set-buffer article-buffer) + (funcall gnus-followup-to-function group))))) + gnus-use-followup-to)) + (if post + (progn + (gnus-configure-windows '(1 0 0)) + (switch-to-buffer gnus-post-news-buffer)) + (gnus-configure-windows '(0 1 0)) + (if (not yank) + (progn + (switch-to-buffer article-buffer) + (pop-to-buffer gnus-post-news-buffer)) + (switch-to-buffer gnus-post-news-buffer))) + (gnus-overload-functions) + (make-local-variable 'gnus-article-reply) + (make-local-variable 'gnus-article-check-size) + (setq gnus-article-reply sumart) + ;; Handle `gnus-auto-mail-to-author'. + ;; Suggested by Daniel Quinlan . + (let ((to (if (eq gnus-auto-mail-to-author 'ask) + (and (y-or-n-p "Also send mail to author? ") from) + (and gnus-auto-mail-to-author from)))) + (if to + (progn + (if (mail-fetch-field "To") + (progn + (beginning-of-line) + (insert "Cc: " to "\n")) + (mail-position-on-field "To") + (insert to))))) + ;; Handle author copy using BCC field. + (if (and gnus-mail-self-blind + (not (mail-fetch-field "bcc"))) + (progn + (mail-position-on-field "Bcc") + (insert (if (stringp gnus-mail-self-blind) + gnus-mail-self-blind + (user-login-name))))) + ;; Handle author copy using FCC field. + (if gnus-author-copy + (progn + (mail-position-on-field "Fcc") + (insert gnus-author-copy))) + (goto-char (point-min)) + (if post + (cond ((not group) + (re-search-forward "^Newsgroup:" nil t) + (end-of-line)) + ((not subject) + (re-search-forward "^Subject:" nil t) + (end-of-line)) + (t + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1))) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (and yank (save-excursion (news-reply-yank-original nil))) + (if gnus-post-prepare-function + (funcall gnus-post-prepare-function group)))))) + (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) + (message "") + t) + + (defun gnus-inews-news (&optional use-group-method) + "Send a news message. + If given a prefix, and the group is a foreign group, this function + will attempt to use the foreign server to post the article." + (interactive "P") + (let* ((case-fold-search nil) + (server-running (gnus-server-opened gnus-select-method)) + (reply gnus-article-reply)) + (save-excursion + ;; Connect to default NNTP server if necessary. + ;; Suggested by yuki@flab.fujitsu.junet. + (gnus-start-news-server) ;Use default server. + ;; NNTP server must be opened before current buffer is modified. + (widen) + (goto-char (point-min)) + (run-hooks 'news-inews-hook) + (save-restriction + (narrow-to-region + (point-min) + (progn + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")))) + + ;; Correct newsgroups field: change sequence of spaces to comma and + ;; eliminate spaces around commas. Eliminate imbedded line breaks. + (goto-char (point-min)) + (if (search-forward-regexp "^Newsgroups: +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil 'end) + (match-beginning 0) + (point-max))) + (goto-char (point-min)) + (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) + (goto-char (point-min)) + (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) + + ;; Added by Per Abrahamsen . + ;; Help save the the world! + (or + gnus-expert-user + (let ((newsgroups (mail-fetch-field "newsgroups")) + (followup-to (mail-fetch-field "followup-to")) + groups to) + (if (and (string-match "," newsgroups) (not followup-to)) + (progn + (while (string-match "," newsgroups) + (setq groups + (cons (list (substring newsgroups + 0 (match-beginning 0))) + groups)) + (setq newsgroups (substring newsgroups (match-end 0)))) + (setq groups (nreverse (cons (list newsgroups) groups))) + + (setq to + (completing-read "Followups to: (default all groups) " + groups)) + (if (> (length to) 0) + (progn + (goto-char (point-min)) + (insert "Followup-To: " to "\n"))))))) + + ;; Cleanup Followup-To. + (goto-char (point-min)) + (if (search-forward-regexp "^Followup-To: +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil 'end) + (match-beginning 0) + (point-max))) + (goto-char (point-min)) + (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) + (goto-char (point-min)) + (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) + + ;; Mail the message too if To:, Bcc:. or Cc: exists. + (if (or (mail-fetch-field "to" nil t) + (mail-fetch-field "bcc" nil t) + (mail-fetch-field "cc" nil t)) + (if gnus-mail-send-method + (save-excursion + (save-restriction + (widen) + (message "Sending via mail...") + + (if gnus-mail-courtesy-message + (progn + ;; Insert "courtesy" mail message. + (goto-char 1) + (re-search-forward + (concat "^" (regexp-quote + mail-header-separator) "$")) + (forward-line 1) + (insert gnus-mail-courtesy-message) + (funcall gnus-mail-send-method) + (goto-char 1) + (search-forward gnus-mail-courtesy-message) + (replace-match "" t t)) + (funcall gnus-mail-send-method)) + + (message "Sending via mail... done") + + (goto-char 1) + (narrow-to-region + 1 (re-search-forward + (concat "^" (regexp-quote + mail-header-separator) "$"))) + (goto-char 1) + (delete-matching-lines "BCC:.*"))) + (ding) + (message "No mailer defined. To: and/or Cc: fields ignored.") + (sit-for 1)))) + + ;; Send to NNTP server. + (message "Posting to USENET...") + (if (gnus-inews-article use-group-method) + (progn + (message "Posting to USENET... done") + (if (gnus-buffer-exists-p (car-safe reply)) + (progn + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-mark-article-as-replied + (cdr reply)))))) + ;; We cannot signal an error. + (ding) (message "Article rejected: %s" + (gnus-status-message gnus-select-method))) + (set-buffer-modified-p nil)) + ;; If NNTP server is opened by gnus-inews-news, close it by myself. + (or server-running + (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) + (and (fboundp 'bury-buffer) (bury-buffer)) + ;; Restore last window configuration. + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news)) + (setq gnus-winconf-post-news nil))) + + (defun gnus-inews-check-post () + "Check whether the post looks ok." + (or + (not gnus-check-before-posting) + (and + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region + (point) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$"))) + (goto-char (point-min)) + (and + ;; Check for commands in Subject. + (save-excursion + (if (string-match "^cmsg " (mail-fetch-field "subject")) + (gnus-y-or-n-p + "The control code \"cmsg \" is in the subject. Really post? ") + t)) + ;; Check for multiple identical headers. + (save-excursion + (let (found) + (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) + (save-excursion + (or (re-search-forward + (concat "^" (setq found + (buffer-substring + (match-beginning 0) + (- (match-end 0) 2)))) + nil t) + (setq found nil)))) + (if found + (gnus-y-or-n-p + (format "Multiple %s headers. Really post? " found)) + t))) + ;; Check for version and sendsys. + (save-excursion + (if (re-search-forward "^Sendsys:\\|^Version:" nil t) + (gnus-yes-or-no-p + (format "The article contains a %s command. Really post? " + (buffer-substring (match-beginning 0) + (1- (match-end 0))))) + t)) + ;; Check the Message-Id header. + (save-excursion + (let* ((case-fold-search t) + (message-id (mail-fetch-field "message-id"))) + (or (not message-id) + (and (string-match "@" message-id) + (string-match "@[^\\.]*\\." message-id)) + (gnus-yes-or-no-p + (format "The Message-ID looks strange: \"%s\". Really post? " + message-id))))) + ;; Check the From header. + (save-excursion + (let* ((case-fold-search t) + (from (mail-fetch-field "from"))) + (or (not from) + (and (string-match "@" from) + (string-match "@[^\\.]*\\." from)) + (gnus-yes-or-no-p + (format "The From looks strange: \"%s\". Really post? " + from)))))))) + ;; Check for long lines. + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (while (and + (progn + (end-of-line) + (< (current-column) 80)) + (zerop (forward-line 1)))) + (or (bolp) + (eobp) + (gnus-yes-or-no-p + (format + "You have lines longer than 79 characters. Really post? ")))) + ;; Check for control characters. + (save-excursion + (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) + (gnus-y-or-n-p + "The article contains control characters. Really post? ") + t)) + ;; Check excessive size. + (if (> (buffer-size) 60000) + (gnus-y-or-n-p (format "The article is %d octets long. Really post? " + (buffer-size))) + t) + ;; Use the (size . checksum) variable to see whether the + ;; article is empty or has only quoted text. + (if (and (= (buffer-size) (car gnus-article-check-size)) + (= (gnus-article-checksum) (cdr gnus-article-check-size))) + (gnus-yes-or-no-p + "It looks like there's no new text in your article. Really post? ") + t)))) + + (defun gnus-article-checksum () + (let ((sum 0)) + (save-excursion + (while (not (eobp)) + (setq sum (logxor sum (following-char))) + (forward-char 1))) + sum)) + + (defun gnus-cancel-news () + "Cancel an article you posted." + (interactive) + (if (or gnus-expert-user + (gnus-yes-or-no-p "Do you really want to cancel this article? ")) + (let ((from nil) + (newsgroups nil) + (message-id nil) + (distribution nil)) + (save-excursion + ;; Get header info. from original article. + (save-restriction + (gnus-article-show-all-headers) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (narrow-to-region (point-min) (point)) + (setq from (mail-fetch-field "from")) + (setq newsgroups (mail-fetch-field "newsgroups")) + (setq message-id (mail-fetch-field "message-id")) + (setq distribution (mail-fetch-field "distribution"))) + ;; Verify if the article is absolutely user's by comparing + ;; user id with value of its From: field. + (if (not + (string-equal + (downcase (mail-strip-quoted-names from)) + (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) + (progn + (ding) (message "This article is not yours.")) + ;; Make control article. + (set-buffer (get-buffer-create " *Gnus-canceling*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert "Newsgroups: " newsgroups "\n" + "Subject: cancel " message-id "\n" + "Control: cancel " message-id "\n" + mail-header-separator "\n" + "This is a cancel message from " from ".\n") + ;; Send the control article to NNTP server. + (message "Canceling your article...") + (if (gnus-inews-article) + (message "Canceling your article... done") + (ding) + (message "Cancel failed; %s" + (gnus-status-message gnus-newsgroup-name))) + ;; Kill the article buffer. + (kill-buffer (current-buffer))))))) + + + ;;; Lowlevel inews interface + + (defun gnus-inews-article (&optional use-group-method) + "Post an article in current buffer using NNTP protocol." + ;; Check whether the article is a good Net Citizen. + (if (and gnus-article-check-size (not (gnus-inews-check-post))) + ;; Aber nein! + () + ;; Looks ok, so we do the nasty. + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-posting*"))) + (widen) + (goto-char (point-max)) + ;; require a newline at the end for inews to append .signature to + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Prepare article headers. All message body such as signature + ;; must be inserted before Lines: field is prepared. + (save-restriction + (goto-char (point-min)) + (narrow-to-region + (point-min) + (save-excursion + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (match-beginning 0))) + (gnus-inews-remove-headers) + (gnus-inews-insert-headers) + (run-hooks gnus-inews-article-header-hook) + (widen)) + (save-excursion + (set-buffer tmpbuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring artbuf) + ;; Remove the header separator. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (replace-match "" t t) + ;; This hook may insert a signature. + (run-hooks 'gnus-prepare-article-hook) + ;; Run final inews hooks. This hook may do FCC. + ;; The article must be saved before being posted because + ;; `gnus-request-post' modifies the buffer. + (run-hooks 'gnus-inews-article-hook) + ;; Post an article to NNTP server. + ;; Return NIL if post failed. + (prog1 + (gnus-request-post + (if use-group-method + (gnus-find-method-for-group gnus-newsgroup-name) + gnus-select-method) use-group-method) + (kill-buffer (current-buffer))))))) + + (defun gnus-inews-remove-headers () + (let ((case-fold-search t)) + ;; Remove NNTP-posting-host. + (goto-char (point-min)) + (and (re-search-forward "^nntp-posting-host:" nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + ;; Remove Bcc. + (goto-char (point-min)) + (and (re-search-forward "^bcc:" nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))))) + + (defun gnus-inews-insert-headers () + "Prepare article headers. + Headers already prepared in the buffer are not modified. + Headers in `gnus-required-headers' will be generated." + (let ((Date (gnus-inews-date)) + (Message-ID (gnus-inews-message-id)) + (Organization (gnus-inews-organization)) + (From (gnus-inews-user-name)) + (Path (gnus-inews-path)) + (Subject nil) + (Newsgroups nil) + (Distribution nil) + (Lines (gnus-inews-lines)) + (X-Newsreader gnus-version) + (headers gnus-required-headers) + (case-fold-search t) + header value elem) + ;; First we remove any old Message-IDs. This might be slightly + ;; fascist, but if the user really wants to generate Message-IDs + ;; by herself, she should remove it from the `gnus-required-list'. + (goto-char (point-min)) + (and (memq 'Message-ID headers) + (re-search-forward "^Message-ID:" nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + ;; Insert new Sender if the From is strange. + (let ((from (mail-fetch-field "from"))) + (if (and from (not (string= (downcase from) (downcase From)))) + (progn + (goto-char (point-min)) + (and (re-search-forward "^Sender:" nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + (insert "Sender: " From "\n")))) + ;; If there are References, and no "Re: ", then the thread has + ;; changed name. See Son-of-1036. + (if (and (mail-fetch-field "references") + (get-buffer gnus-article-buffer)) + (let ((psubject (gnus-simplify-subject-re + (mail-fetch-field "subject"))) + subject) + (save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (gnus-narrow-to-headers) + (if (setq subject (mail-fetch-field "subject")) + (progn + (and gnus-summary-gather-subject-limit + (numberp gnus-summary-gather-subject-limit) + (> (length subject) gnus-summary-gather-subject-limit) + (setq subject + (substring subject 0 + gnus-summary-gather-subject-limit))) + (setq subject (gnus-simplify-subject-re subject)))))) + (or (and psubject subject (string= subject psubject)) + (progn + (string-match "@" Message-ID) + (setq Message-ID + (concat (substring Message-ID 0 (match-beginning 0)) + "_-_" + (substring Message-ID (match-beginning 0)))))))) + ;; Go through all the required headers and see if they are in the + ;; articles already. If they are not, or are empty, they are + ;; inserted automatically - except for Subject, Newsgroups and + ;; Distribution. + (while headers + (goto-char (point-min)) + (setq elem (car headers)) + (if (consp elem) + (setq header (car elem)) + (setq header elem)) + (if (or (not (re-search-forward + (concat "^" (downcase (symbol-name header)) ":") nil t)) + (progn + (if (= (following-char) ? ) (forward-char 1) (insert " ")) + (looking-at "[ \t]*$"))) + (progn + (setq value + (or (if (consp elem) + ;; The element is a cons. Either the cdr is + ;; a string to be inserted verbatim, or it + ;; is a function, and we insert the value + ;; returned from this function. + (or (and (stringp (cdr elem)) (cdr elem)) + (and (fboundp (cdr elem)) (funcall (cdr elem)))) + ;; The element is a symbol. We insert the + ;; value of this symbol, if any. + (and (boundp header) (symbol-value header))) + ;; We couldn't generate a value for this header, + ;; so we just ask the user. + (read-from-minibuffer + (format "Empty header for %s; enter value: " header)))) + (if (bolp) + (save-excursion + (goto-char (point-max)) + (insert (symbol-name header) ": " value "\n")) + (replace-match value t t)))) + (setq headers (cdr headers))))) + + (defun gnus-inews-insert-signature () + "Insert a signature file. + If `gnus-signature-function' is bound and returns a string, this + string is used instead of the variable `gnus-signature-file'. + In either case, if the string is a file name, this file is + inserted. If the string is not a file name, the string itself is + inserted. + If you never want any signature inserted, set both those variables to + nil." + (save-excursion + (let ((signature + (or (and gnus-signature-function + (fboundp gnus-signature-function) + (funcall gnus-signature-function gnus-newsgroup-name)) + gnus-signature-file)) + b) + (if (and signature + (or (file-exists-p signature) + (string-match " " signature) + (not (string-match + "^/[^/]+/" (expand-file-name signature))))) + (progn + (goto-char (point-max)) + ;; Delete any previous signatures. + (if (and mail-signature (search-backward "\n-- \n" nil t)) + (delete-region (1+ (point)) (point-max))) + (insert "\n-- \n") + (and (< 4 (setq b (count-lines + (point) + (progn + (if (file-exists-p signature) + (insert-file-contents signature) + (insert signature)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (point))))) + (not gnus-expert-user) + (not + (gnus-y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + b))) + (if (file-exists-p signature) + (error (format "Edit %s." signature)) + (error "Trim your signature.")))))))) + + (defun gnus-inews-do-fcc () + "Process FCC: fields in current article buffer. + Unless the first character of the field is `|', the article is saved + to the specified file using the function specified by the variable + gnus-author-copy-saver. The default function rmail-output saves in + Unix mailbox format. + If the first character is `|', the contents of the article is send to + a program specified by the rest of the value." + (let ((fcc-list nil) + (fcc-file nil) + (case-fold-search t)) ;Should ignore case. + (save-excursion + (save-restriction + (goto-char (point-min)) + (search-forward "\n\n") + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (while (re-search-forward "^FCC:[ \t]*" nil t) + (setq fcc-list + (cons (buffer-substring + (point) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point))) + fcc-list)) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + ;; Process FCC operations. + (widen) + (while fcc-list + (setq fcc-file (car fcc-list)) + (setq fcc-list (cdr fcc-list)) + (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) + (let ((program (substring fcc-file + (match-beginning 1) (match-end 1)))) + ;; Suggested by yuki@flab.fujitsu.junet. + ;; Send article to named program. + (call-process-region (point-min) (point-max) shell-file-name + nil nil nil "-c" program))) + (t + ;; Suggested by hyoko@flab.fujitsu.junet. + ;; Save article in Unix mail format by default. + (if (and gnus-author-copy-saver + (not (eq gnus-author-copy-saver 'rmail-output))) + (funcall gnus-author-copy-saver fcc-file) + (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file)) + (gnus-output-to-rmail fcc-file) + (rmail-output fcc-file 1 t t)))))))))) + + (defun gnus-inews-path () + "Return uucp path." + (let ((login-name (gnus-inews-login-name))) + (cond ((null gnus-use-generic-path) + (concat (nth 1 gnus-select-method) "!" login-name)) + ((stringp gnus-use-generic-path) + ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. + (concat gnus-use-generic-path "!" login-name)) + (t login-name)))) + + (defun gnus-inews-user-name () + "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." + (let ((full-name (gnus-inews-full-name))) + (or gnus-user-from-line + (concat (if (or gnus-user-login-name gnus-use-generic-from + gnus-local-domain (getenv "DOMAINNAME")) + (concat (gnus-inews-login-name) "@" + (gnus-inews-domain-name gnus-use-generic-from)) + user-mail-address) + ;; User's full name. + (cond ((string-equal full-name "") "") + ((string-equal full-name "&") ;Unix hack. + (concat " (" (user-login-name) ")")) + (t + (concat " (" full-name ")"))))))) + + (defun gnus-inews-login-name () + "Return login name." + (or gnus-user-login-name (getenv "LOGNAME") (user-login-name))) + + (defun gnus-inews-full-name () + "Return full user name." + (or gnus-user-full-name (getenv "NAME") (user-full-name))) + + (defun gnus-inews-domain-name (&optional genericfrom) + "Return user's domain name. + If optional argument GENERICFROM is a string, use it as the domain + name; if it is non-nil, strip off local host name from the domain name. + If the function `system-name' returns full internet name and the + domain is undefined, the domain name is got from it." + (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) + (let* ((system-name (system-name)) + (domain + (or (if (stringp genericfrom) genericfrom) + (getenv "DOMAINNAME") + gnus-local-domain + ;; Function `system-name' may return full internet name. + ;; Suggested by Mike DeCorte . + (if (string-match "\\." system-name) + (substring system-name (match-end 0))) + (read-string "Domain name (no host): "))) + (host (or (if (string-match "\\." system-name) + (substring system-name 0 (match-beginning 0))) + system-name))) + (if (string-equal "." (substring domain 0 1)) + (setq domain (substring domain 1))) + ;; Support GENERICFROM as same as standard Bnews system. + ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. + (cond ((null genericfrom) + (concat host "." domain)) + ;;((stringp genericfrom) genericfrom) + (t domain))) + (if (string-match "\\." (system-name)) + (system-name) + (substring user-mail-address + (1+ (string-match "@" user-mail-address)))))) + + (defun gnus-inews-full-address () + (let ((domain (gnus-inews-domain-name)) + (system (system-name)) + (case-fold-search t)) + (if (string-match "\\." system) system + (if (string-match (concat "^" (regexp-quote system)) domain) domain + (concat system "." domain))))) + + (defun gnus-inews-message-id () + "Generate unique Message-ID for user." + ;; Message-ID should not contain a slash and should be terminated by + ;; a number. I don't know the reason why it is so. + (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">")) + + (defun gnus-inews-unique-id () + "Generate unique ID from user name and current time." + (concat (downcase (gnus-inews-login-name)) + (mapconcat + (lambda (num) (gnus-number-base31 num 3)) + (current-time) ""))) + + + (defvar gnus-unique-id-char nil) + + ;; If you ever change this function, make sure the new version + ;; cannot generate IDs that the old version could. + ;; You might for example insert a "." somewhere (not next to another dot + ;; or string boundary), or modify the newsreader name to "Ding". + (defun gnus-inews-unique-id-new () + ;; Dont use microseconds from (current-time), they may be unsupported. + ;; Instead we use this randomly inited counter. + (setq gnus-unique-id-char + (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20))))) + ;; (current-time) returns 16-bit ints, + ;; and 2^16*25 just fits into 4 digits i base 36. + (* 25 25))) + (let ((tm (if (fboundp 'current-time) + (current-time) '(12191 46742 287898)))) + (concat + (if (memq system-type '(ms-dos emx vax-vms)) + (let ((user (downcase (gnus-inews-login-name)))) + (while (string-match "[^a-z0-9_]" user) + (aset user (match-beginning 0) ?_)) + user) + (gnus-number-base36 (user-uid) -1)) + (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4) + (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4) + ;; Append the newsreader name, because while the generated + ;; ID is unique to this newsreader, other newsreaders might + ;; otherwise generate the same ID via another algorithm. + ".DING"))) + + + (defun gnus-inews-date () + "Current time string." + (timezone-make-date-arpa-standard + (current-time-string) (current-time-zone))) + + (defun gnus-inews-organization () + "Return user's organization. + The ORGANIZATION environment variable is used if defined. + If not, the variable `gnus-local-organization' is used instead. + If it is a function, the function will be called with the current + newsgroup name as the argument. + If this is a file name, the contents of this file will be used as the + organization." + (let* ((organization + (or (getenv "ORGANIZATION") + (if gnus-local-organization + (if (and (symbolp gnus-local-organization) + (fboundp gnus-local-organization)) + (funcall gnus-local-organization gnus-newsgroup-name) + gnus-local-organization)) + gnus-organization-file + "~/.organization"))) + (and (stringp organization) + (> (length organization) 0) + (or (file-exists-p organization) + (string-match " " organization) + (not (string-match "^/[^/]+/" (expand-file-name organization)))) + (save-excursion + (gnus-set-work-buffer) + (if (file-exists-p organization) + (insert-file-contents organization) + (insert organization)) + (goto-char (point-min)) + (while (re-search-forward " *\n *" nil t) + (replace-match " " t t)) + (buffer-substring (point-min) (point-max)))))) + + (defun gnus-inews-lines () + "Count the number of lines and return numeric string." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (int-to-string (count-lines (point) (point-max)))))) + + + ;;; + ;;; Gnus Mail Functions + ;;; + + ;;; Mail reply commands of Gnus summary mode + + (defun gnus-summary-reply (yank) + "Reply mail to news author. + If prefix argument YANK is non-nil, original article is yanked automatically. + Customize the variable gnus-mail-reply-method to use another mailer." + (interactive "P") + ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) + ;; Stripping headers should be specified with mail-yank-ignored-headers. + (gnus-set-global-variables) + (setq gnus-winconf-post-news (current-window-configuration)) + (gnus-summary-select-article t) + (let ((gnus-newsgroup-name gnus-newsgroup-name)) + (bury-buffer gnus-article-buffer) + (funcall gnus-mail-reply-method yank)) + (gnus-article-hide-headers-if-wanted)) + + (defun gnus-summary-reply-with-original () + "Reply mail to news author with original article. + Customize the variable gnus-mail-reply-method to use another mailer." + (interactive) + (gnus-summary-reply t)) + + (defun gnus-summary-mail-forward (post) + "Forward the current message to another user. + Customize the variable gnus-mail-forward-method to use another mailer." + (interactive "P") + (gnus-summary-select-article t) + (setq gnus-winconf-post-news (current-window-configuration)) + (if gnus-split-window + (widen) + (switch-to-buffer gnus-article-buffer) + (widen) + (delete-other-windows) + (bury-buffer gnus-article-buffer)) + (let ((gnus-newsgroup-name gnus-newsgroup-name)) + (if post + (gnus-forward-using-post) + (funcall gnus-mail-forward-method))) + (gnus-article-hide-headers-if-wanted)) + + (defun gnus-summary-post-forward () + "Forward the current article to a newsgroup." + (interactive) + (gnus-summary-mail-forward t)) + + (defun gnus-summary-mail-other-window () + "Compose mail in other window. + Customize the variable `gnus-mail-other-window-method' to use another + mailer." + (interactive) + (setq gnus-winconf-post-news (current-window-configuration)) + (let ((gnus-newsgroup-name gnus-newsgroup-name)) + (funcall gnus-mail-other-window-method))) + + (defun gnus-mail-reply-using-mail (&optional yank to-address) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) + (group (gnus-group-real-name gnus-newsgroup-name)) + (cur (cons (current-buffer) (cdr gnus-article-current))) + from subject date to reply-to message-of + references message-id sender follow-to cc sendto elt) + (set-buffer (get-buffer-create "*mail*")) + (mail-mode) + (make-local-variable 'gnus-article-reply) + (setq gnus-article-reply cur) + (use-local-map (copy-keymap mail-mode-map)) + (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) + (if (and (buffer-modified-p) + (> (buffer-size) 0) + (not (gnus-y-or-n-p + "Unsent article being composed; erase it? "))) + () + (erase-buffer) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (narrow-to-region (point-min) + (progn (search-forward "\n\n") (point))) + (add-text-properties (point-min) (point-max) '(invisible nil))) + (if (and (boundp 'gnus-reply-to-function) + gnus-reply-to-function) + (save-excursion + (save-restriction + (gnus-narrow-to-headers) + (setq follow-to (funcall gnus-reply-to-function group))))) + (setq from (mail-fetch-field "from")) + (setq date (mail-fetch-field "date")) + (and from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (setq message-of + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " date)))) + (setq sender (mail-fetch-field "sender")) + (setq subject (or (mail-fetch-field "subject") + "Re: none")) + (or (string-match "^[Rr][Ee]:" subject) + (setq subject (concat "Re: " subject))) + (setq cc (mail-fetch-field "cc")) + (setq reply-to (mail-fetch-field "reply-to")) + (setq references (mail-fetch-field "references")) + (setq message-id (mail-fetch-field "message-id")) + (widen)) + (setq news-reply-yank-from from) + (setq news-reply-yank-message-id message-id) + + ;; Gather the "to" addresses out of the follow-to list and remove + ;; them as we go. + (if (and follow-to (listp follow-to)) + (while (setq elt (assoc "To" follow-to)) + (setq sendto (concat sendto (and sendto ", ") (cdr elt))) + (setq follow-to (delq elt follow-to)))) + + (mail-setup (or to-address + (if (and follow-to (not (stringp follow-to))) sendto + (or follow-to reply-to from sender ""))) + subject message-of nil gnus-article-buffer nil) + + (if (and follow-to (listp follow-to)) + (progn + (goto-char (point-min)) + (re-search-forward "^To:" nil t) + (beginning-of-line) + (forward-line 1) + (while follow-to + (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") + (setq follow-to (cdr follow-to))))) + ;; Fold long references line to follow RFC1036. + (mail-position-on-field "References") + (let ((begin (- (point) (length "References: "))) + (fill-column 78) + (fill-prefix "\t")) + (if references (insert references)) + (if (and references message-id) (insert " ")) + (if message-id (insert message-id)) + ;; The region must end with a newline to fill the region + ;; without inserting extra newline. + (fill-region-as-paragraph begin (1+ (point)))) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (if yank + (let ((last (point))) + (save-excursion + (mail-yank-original nil)) + (run-hooks 'news-reply-header-hook) + (goto-char last)))) + (let ((mail (current-buffer))) + (if yank + (progn + (gnus-configure-windows '(0 1 0)) + (switch-to-buffer mail)) + (gnus-configure-windows '(0 0 1)) + (switch-to-buffer-other-window mail)))))) + + (defun gnus-mail-yank-original () + (interactive) + (save-excursion + (mail-yank-original nil)) + (run-hooks 'news-reply-header-hook)) + + (defun gnus-mail-send-and-exit () + (interactive) + (let ((cbuf (current-buffer))) + (mail-send-and-exit nil) + (if (get-buffer gnus-group-buffer) + (progn + (save-excursion + (set-buffer cbuf) + (let ((reply gnus-article-reply)) + (if (gnus-buffer-exists-p (car-safe reply)) + (progn + (set-buffer (car reply)) + (and (cdr reply) + (gnus-summary-mark-article-as-replied + (cdr reply))))))) + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news)) + (setq gnus-winconf-post-news nil))))) + + (defun gnus-forward-make-subject () + (concat "[" (if (memq 'mail (assoc (symbol-name + (car (gnus-find-method-for-group + gnus-newsgroup-name))) + gnus-valid-select-methods)) + (gnus-fetch-field "From") + gnus-newsgroup-name) + "] " (or (gnus-fetch-field "Subject") ""))) + + (defun gnus-forward-insert-buffer (buffer) + (let ((beg (goto-char (point-max)))) + (insert "------- Start of forwarded message -------\n") + (insert-buffer buffer) + (goto-char (point-max)) + (insert "------- End of forwarded message -------\n") + ;; Suggested by Sudish Joseph . + (goto-char beg) + (while (setq beg (next-single-property-change (point) 'invisible)) + (goto-char beg) + (delete-region beg (or (next-single-property-change + (point) 'invisible) + (point-max)))))) + + (defun gnus-mail-forward-using-mail () + "Forward the current message to another user using mail." + ;; This is almost a carbon copy of rmail-forward in rmail.el. + (let ((forward-buffer (current-buffer)) + (subject (gnus-forward-make-subject))) + ;; If only one window, use it for the mail buffer. Otherwise, use + ;; another window for the mail buffer so that the Rmail buffer + ;; remains visible and sending the mail will get back to it. + (if (if (one-window-p t) + (mail nil nil subject) + (mail-other-window nil nil subject)) + (save-excursion + (use-local-map (copy-keymap (current-local-map))) + (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) + (gnus-forward-insert-buffer forward-buffer) + ;; You have a chance to arrange the message. + (run-hooks 'gnus-mail-forward-hook))))) + + (defun gnus-forward-using-post () + (let ((forward-buffer (current-buffer)) + (subject (gnus-forward-make-subject))) + (gnus-post-news 'post nil nil nil nil subject) + (save-excursion + (gnus-forward-insert-buffer forward-buffer) + ;; You have a chance to arrange the message. + (run-hooks 'gnus-mail-forward-hook)))) + + (defun gnus-mail-other-window-using-mail () + "Compose mail other window using mail." + (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) + (use-local-map (copy-keymap (current-local-map))) + (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)) + + (provide 'gnus-msg) + + ;;; gnus-message.el ends here diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-score.el dgnus/lisp/gnus-score.el *** pub/dgnus/lisp/gnus-score.el Wed Apr 26 17:03:52 1995 --- dgnus/lisp/gnus-score.el Thu Apr 27 23:52:30 1995 *************** *** 647,653 **** (read-only (gnus-score-get 'read-only alist)) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) ! (orphan (gnus-score-get 'orphan alist)) (adapt (gnus-score-get 'adapt alist)) (eval (gnus-score-get 'eval alist))) ;; We do not respect eval and files atoms from global score --- 647,653 ---- (read-only (gnus-score-get 'read-only alist)) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) ! (orphan (car (gnus-score-get 'orphan alist))) (adapt (gnus-score-get 'adapt alist)) (eval (gnus-score-get 'eval alist))) ;; We do not respect eval and files atoms from global score *************** *** 661,669 **** (setq gnus-scores-exclude-files exclude-files) (if orphan (setq gnus-orphan-score (car orphan))) (setq gnus-adaptive-score-alist ! (cond ((eq adapt t) gnus-default-adaptive-score-alist) ! ((eq adapt 'ignore) nil) ((consp adapt) adapt))) --- 661,669 ---- (setq gnus-scores-exclude-files exclude-files) (if orphan (setq gnus-orphan-score (car orphan))) (setq gnus-adaptive-score-alist ! (cond ((equal adapt '(t)) gnus-default-adaptive-score-alist) ! ((equal adapt '(ignore)) nil) ((consp adapt) adapt))) *************** *** 785,791 **** (gnus-score-get 'read-only score) (not (file-writable-p file))) () ! (setq score (delq (assq 'touched score) score)) (erase-buffer) (let (emacs-lisp-mode-hook) (pp score (current-buffer))) --- 785,791 ---- (gnus-score-get 'read-only score) (not (file-writable-p file))) () ! (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) (let (emacs-lisp-mode-hook) (pp score (current-buffer))) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-uu.el dgnus/lisp/gnus-uu.el *** pub/dgnus/lisp/gnus-uu.el Wed Apr 26 17:03:52 1995 --- dgnus/lisp/gnus-uu.el Fri Apr 28 00:32:57 1995 *************** *** 27,33 **** ;;; Code: (require 'gnus) ! (require 'gnus-message) ;; Default viewing action rules --- 27,33 ---- ;;; Code: (require 'gnus) ! (require 'gnus-msg) ;; Default viewing action rules *************** *** 1074,1080 **** (defun gnus-uu-part-number (article) (let ((subject (header-subject (gnus-get-header-by-number article)))) ! (if (string-match "([0-9]+ */[0-9]+)\\|([0-9]+ * of *[0-9]+)" subject) (substring subject (match-beginning 0) (match-end 0)) ""))) --- 1074,1080 ---- (defun gnus-uu-part-number (article) (let ((subject (header-subject (gnus-get-header-by-number article)))) ! (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject) (substring subject (match-beginning 0) (match-end 0)) ""))) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-vis.el dgnus/lisp/gnus-vis.el *** pub/dgnus/lisp/gnus-vis.el Thu Apr 27 21:41:15 1995 --- dgnus/lisp/gnus-vis.el Thu Apr 27 23:01:16 1995 *************** *** 0 **** --- 1,500 ---- + ;;; gnus-visual: display-oriented parts of Gnus. + ;; Copyright (C) 1995 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (require (if gnus-xemacs 'auc-menu 'easymenu)) + + (defvar gnus-summary-selected-face 'underline + "*Face used for highlighting the current article in the summary buffer.") + + (defvar gnus-visual-summary-highlight + '(((> score default) . bold) + ((< score default) . italic)) + "*Alist of `(FORM . FACE)'. + Summary lines are highlighted with the FACE for the first FORM which + evaluate to a non-nil value. + + Point will be at the beginning of the line when FORM is evaluated. + The following can be used for convenience: + + score: (gnus-summary-article-score) + default: gnus-summary-default-score + below: gnus-summary-mark-below + + To check for marks, e.g. to underline replied articles, use + `gnus-summary-article-mark': + + ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)") + + (eval-and-compile + (autoload 'nnkiboze-generate-groups "nnkiboze")) + + ;; Newsgroup buffer + + ;; Make a menu bar item. + (defun gnus-group-make-menu-bar () + (easy-menu-define + gnus-group-reading-menu + gnus-group-mode-map + "" + '("Group" + ["Read" gnus-group-read-group t] + ["Select" gnus-group-select-group t] + ["Catch up" gnus-group-catchup-current t] + ["Catch up all articles" gnus-group-catchup-current-all t] + ["Check for new articles" gnus-group-get-new-news-this-group t] + ["Toggle subscription" gnus-group-unsubscribe-current-group t] + ["Kill" gnus-group-kill-group t] + ["Yank" gnus-group-yank-group t] + ["Describe" gnus-group-describe-group t] + ["Fetch FAQ" gnus-group-fetch-faq t] + ["Edit kill file" gnus-group-edit-local-kill t] + ["Expire articles" gnus-group-expire-articles t] + ["Set group level" gnus-group-set-current-level t] + )) + + (easy-menu-define + gnus-group-group-menu + gnus-group-mode-map + "" + '("Groups" + ("Listing" + ["List subscribed groups" gnus-group-list-groups t] + ["List all groups" gnus-group-list-all-groups t] + ["List groups matching..." gnus-group-list-matching t] + ["List killed groups" gnus-group-list-killed t] + ["List zombie groups" gnus-group-list-zombies t] + ["Describe all groups" gnus-group-describe-all-groups t] + ["Group apropos" gnus-group-apropos t] + ["Group and description apropos" gnus-group-description-apropos t] + ["List groups matching..." gnus-group-list-matching t]) + ("Subscribe" + ["Subscribe to random group" gnus-group-unsubscribe-group t] + ["Kill all newsgroups in region" gnus-group-kill-region t] + ["Kill all zombie groups" gnus-group-kill-all-zombies t]) + ("Foreign groups" + ["Make a foreign group" gnus-group-make-group t] + ["Edit a group entry" gnus-group-edit-group t] + ["Add a directory group" gnus-group-make-directory-group t] + ["Add the help group" gnus-group-make-help-group t] + ["Add the archive group" gnus-group-make-archive-group t] + ["Make a kiboze group" gnus-group-make-kiboze-group t]) + ["Jump to group" gnus-group-jump-to-group t] + ["Best unread group" gnus-group-best-unread-group t] + )) + + (easy-menu-define + gnus-group-post-menu + gnus-group-mode-map + "" + '("Post" + ["Send a mail" gnus-group-mail t] + ["Post an article" gnus-group-post-news t] + )) + + (easy-menu-define + gnus-group-misc-menu + gnus-group-mode-map + "" + '("Misc" + ["Check for new news" gnus-group-get-new-news t] + ["Delete bogus groups" gnus-group-check-bogus-groups t] + ["Find new newsgroups" gnus-find-new-newsgroups t] + ["Restart Gnus" gnus-group-restart t] + ["Read init file" gnus-group-read-init-file t] + ["Browse foreign server" gnus-group-browse-foreign-server t] + ["Edit the global kill file" gnus-group-edit-global-kill t] + ["Expire all expirable articles" gnus-group-expire-all-groups t] + ["Generate any kiboze groups" nnkiboze-generate-groups t] + ["Gnus version" gnus-version t] + ["Save .newsrc files" gnus-group-save-newsrc t] + ["Suspend Gnus" gnus-group-suspend t] + ["Clear dribble buffer" gnus-group-clear-dribble t] + ["Exit from Gnus" gnus-group-exit t] + ["Exit without saving" gnus-group-quit t] + ["Sort group buffer" gnus-group-sort-groups t] + ["Edit global KILL file" gnus-group-edit-global-kill t] + )) + + ) + + ;; Summary buffer + (defun gnus-summary-make-menu-bar () + + (easy-menu-define + gnus-summary-mark-menu + gnus-summary-mode-map + "" + '("Mark" + ("Read" + ["Mark as read" gnus-summary-mark-as-read-forward t] + ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] + ["Mark same subject" gnus-summary-kill-same-subject t] + ["Catchup" gnus-summary-catchup t] + ["Catchup all" gnus-summary-catchup-all t] + ["Catchup to here" gnus-summary-catchup-to-here t] + ["Catchup region" gnus-summary-mark-region-as-read t]) + ("Various" + ["Tick" gnus-summary-tick-article-forward t] + ["Mark as dormant" gnus-summary-mark-as-dormant t] + ["Remove marks" gnus-summary-clear-mark-forward t] + ["Set expirable mark" gnus-summary-mark-as-expirable t] + ["Set bookmark" gnus-summary-set-bookmark t] + ["Remove bookmark" gnus-summary-remove-bookmark t]) + ("Score" + ["Raise score" gnus-summary-raise-score t] + ["Lower score" gnus-summary-lower-score t] + ["Set score" gnus-summary-set-score t]) + ("Display" + ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t] + ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t] + ["Show dormant articles" gnus-summary-show-all-dormant t] + ["Hide dormant articles" gnus-summary-hide-all-dormant t] + ["Show expunged articles" gnus-summary-show-all-expunged t]) + ("Process mark" + ["Set mark" gnus-summary-mark-as-processable t] + ["Remove mark" gnus-summary-unmark-as-processable t] + ["Remove all marks" gnus-summary-unmark-all-processable t] + ["Mark series" gnus-uu-mark-series t] + ["Mark region" gnus-uu-mark-region t] + ["Mark by regexp" gnus-uu-mark-by-regexp t] + ["Mark all" gnus-uu-mark-all t] + ["Mark sparse" gnus-uu-mark-sparse t] + ["Mark thread" gnus-uu-mark-thread t] + ) + )) + + (easy-menu-define + gnus-summary-move-menu + gnus-summary-mode-map + "" + '("Move" + ["Scroll article forwards" gnus-summary-next-page t] + ["Next unread article" gnus-summary-next-unread-article t] + ["Previous unread article" gnus-summary-prev-unread-article t] + ["Next article" gnus-summary-next-article t] + ["Previous article" gnus-summary-prev-article t] + ["Next article same subject" gnus-summary-next-same-subject t] + ["Previous article same subject" gnus-summary-prev-same-subject t] + ["First unread article" gnus-summary-first-unread-article t] + ["Go to subject number..." gnus-summary-goto-subject t] + ["Go to the last article" gnus-summary-goto-last-article t] + ["Pop article off history" gnus-summary-pop-article t] + )) + + (easy-menu-define + gnus-summary-article-menu + gnus-summary-mode-map + "" + '("Article" + ("Hide" + ("Date" + ["Local" gnus-article-date-local t] + ["UT" gnus-article-date-local t] + ["Lapsed" gnus-article-date-local t]) + ["Headers" gnus-article-hide-headers t] + ["Signature" gnus-article-hide-signature t] + ["Citation" gnus-article-hide-citation t] + ["Overstrike" gnus-article-treat-overstrike t] + ["Word wrap" gnus-article-word-wrap t] + ["CR" gnus-article-remove-cr t] + ["Show X-Face" gnus-article-display-x-face t] + ["Quoted-Printable" gnus-article-de-quoted-unreadable t]) + ("Extract" + ["Uudecode" gnus-uu-decode-uu t] + ["Uudecode and save" gnus-uu-decode-uu-and-save t] + ["Unshar" gnus-uu-decode-unshar t] + ["Unshar and save" gnus-uu-decode-unshar-and-save t] + ["Save" gnus-uu-decode-save t] + ["Binhex" gnus-uu-decode-binhex t]) + ["Enter digest buffer" gnus-summary-enter-digest-group t] + ["Isearch article" gnus-summary-isearch-article t] + ["Search all articles" gnus-summary-search-article-forward t] + ["Beginning of the article" gnus-summary-beginning-of-article t] + ["End of the article" gnus-summary-end-of-article t] + ["Fetch parent of article" gnus-summary-refer-parent-article t] + ["Fetch article with id..." gnus-summary-refer-article t] + ["Stop page breaking" gnus-summary-stop-page-breaking t] + ["Caesar rotate" gnus-summary-caesar-message t] + ["Redisplay" gnus-summary-show-article t] + ["Toggle header" gnus-summary-toggle-header t] + ["Toggle MIME" gnus-summary-toggle-mime t] + ["Save" gnus-summary-save-article t] + ["Save in mail format" gnus-summary-save-article-mail t] + ["Pipe through a filter" gnus-summary-pipe-output t] + ("Mail articles" + ["Respool article" gnus-summary-respool-article t] + ["Move article" gnus-summary-move-article t] + ["Edit article" gnus-summary-edit-article t] + ["Delete article" gnus-summary-delete-article t]) + )) + + (easy-menu-define + gnus-summary-thread-menu + gnus-summary-mode-map + "" + '("Threads" + ["Toggle threading" gnus-summary-toggle-threads t] + ["Display hidden thread" gnus-summary-show-thread t] + ["Hide thread" gnus-summary-hide-thread t] + ["Go to next thread" gnus-summary-next-thread t] + ["Go to previous thread" gnus-summary-prev-thread t] + ["Go down thread" gnus-summary-down-thread t] + ["Go up thread" gnus-summary-up-thread t] + ["Mark thread as read" gnus-summary-kill-thread t] + ["Lower thread score" gnus-summary-lower-thread t] + ["Raise thread score" gnus-summary-raise-thread t] + )) + + (easy-menu-define + gnus-summary-misc-menu + gnus-summary-mode-map + "" + '("Misc" + ("Sort" + ["Sort by number" gnus-summary-sort-by-number t] + ["Sort by author" gnus-summary-sort-by-author t] + ["Sort by subject" gnus-summary-sort-by-subject t] + ["Sort by date" gnus-summary-sort-by-date t]) + ("Exit" + ["Catchup and exit" gnus-summary-catchup-and-exit t] + ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] + ["Exit group" gnus-summary-exit t] + ["Exit group without updating" gnus-summary-quit t] + ["Reselect group" gnus-summary-reselect-current-group t] + ["Rescan group" gnus-summary-rescan-group t]) + ["Fetch group FAQ" gnus-summary-fetch-faq t] + ["Filter articles" gnus-summary-execute-command t] + ["Toggle line truncation" gnus-summary-toggle-truncation t] + ["Expire expirable articles" gnus-summary-expire-articles t] + ["Describe group" gnus-summary-describe-group t] + ["Edit local kill file" gnus-summary-edit-local-kill t] + ["Edit global kill file" gnus-summary-edit-global-kill t] + )) + + (easy-menu-define + gnus-summary-post-menu + gnus-summary-mode-map + "" + '("Post" + ["Post an article" gnus-summary-post-news t] + ["Followup" gnus-summary-followup t] + ["Followup and yank" gnus-summary-followup-with-original t] + ["Supersede article" gnus-summary-supersede-article t] + ["Cancel article" gnus-summary-cancel-article t] + ["Reply" gnus-summary-reply t] + ["Reply and yank" gnus-summary-reply-with-original t] + ["Mail forward" gnus-summary-mail-forward t] + ["Post forward" gnus-summary-post-forward t] + ["Digest and mail" gnus-uu-digest-mail-forward t] + ["Digest and post" gnus-uu-digest-post-forward t] + ["Send a mail" gnus-summary-mail-other-window t] + ["Reply & followup" gnus-summary-followup-and-reply t] + ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] + ["Uuencode and post" gnus-uu-post-news t] + )) + + (easy-menu-define + gnus-summary-kill-menu + gnus-summary-mode-map + "" + '("Score" + ("Score file" + ["Switch current score file" gnus-score-change-score-file t] + ["Set mark below" gnus-score-set-mark-below t] + ["Set expunge below" gnus-score-set-expunge-below t] + ["Edit current score file" gnus-score-edit-alist t] + ["Edit score file" gnus-score-edit-file t]) + ["Raise score with current subject" + gnus-summary-temporarily-raise-by-subject t] + ["Raise score with current author" + gnus-summary-temporarily-raise-by-author t] + ["Raise score with current thread" + gnus-summary-temporarily-raise-by-thread t] + ["Raise score with current crossposting" + gnus-summary-temporarily-raise-by-xref t] + ["Permanently raise score with current subject" + gnus-summary-raise-by-subject t] + ["Permanently raise score with current author" + gnus-summary-raise-by-author t] + ["Permanently raise score with current crossposting" + gnus-summary-raise-by-xref t] + ["Permanently raise score for followups to current author" + gnus-summary-raise-followups-to-author t] + ["Lower score with current subject" + gnus-summary-temporarily-lower-by-subject t] + ["Lower score with current author" + gnus-summary-temporarily-lower-by-author t] + ["Lower score with current thread" + gnus-summary-temporarily-lower-by-thread t] + ["Lower score with current crossposting" + gnus-summary-temporarily-lower-by-xref t] + ["Permanently lower score with current subject" + gnus-summary-lower-by-subject t] + ["Permanently lower score with current author" + gnus-summary-lower-by-author t] + ["Permanently lower score with current crossposting" + gnus-summary-lower-by-xref t] + ["Permanently lower score for followups to current author" + gnus-summary-lower-followups-to-author t] + )) + ) + + ;; Article buffer + (defun gnus-article-make-menu-bar () + + (easy-menu-define + gnus-article-article-menu + gnus-article-mode-map + "" + '("Article" + ["Scroll forwards" gnus-article-next-page t] + ["Scroll backwards" gnus-article-prev-page t] + ["Show summary" gnus-article-show-summary t] + ["Fetch Message-ID at point" gnus-article-refer-article t] + ["Mail to address at point" gnus-article-mail t] + ["Mail to address at point and include original" + gnus-article-mail-with-original t] + )) + + (easy-menu-define + gnus-article-treatment-menu + gnus-article-mode-map + "" + '("Treatment" + ["Hide headers" gnus-article-hide-headers t] + ["Hide signature" gnus-article-hide-signature t] + ["Hide citation" gnus-article-hide-citation t] + ["Treat overstrike" gnus-article-treat-overstrike t] + ["Remove carriage return" gnus-article-remove-cr t] + ["Remove quoted-unreadble" gnus-article-de-quoted-unreadable t] + )) + ) + + (if gnus-xemacs + (defun gnus-visual-highlight-selected-summary () + (if gnus-summary-selected-face + (save-excursion + (let* ((beg (progn (beginning-of-line) (point))) + (end (progn (end-of-line) (point))) + (from (or + (next-single-property-change beg 'mouse-face nil end) + beg)) + (to (or (next-single-property-change from 'mouse-face nil end) + end))) + (if gnus-newsgroup-selected-overlay + (move-overlay gnus-newsgroup-selected-overlay + from to (current-buffer)) + (setq gnus-newsgroup-selected-overlay (make-overlay from to)) + (overlay-put gnus-newsgroup-selected-overlay 'face + gnus-summary-selected-face)))))) + + (defun gnus-visual-highlight-selected-summary () + ;; Added by Per Abrahamsen . + ;; Highlight selected article in summary buffer + (if gnus-summary-selected-face + (save-excursion + (let* ((beg (progn (beginning-of-line) (point))) + (end (progn (end-of-line) (point))) + (to (max 1 (1- (previous-single-property-change + end 'mouse-face nil beg)))) + (from (1+ (next-single-property-change + beg 'mouse-face nil end)))) + (if (< to beg) + (progn + (setq from beg) + (setq to end))) + (if gnus-newsgroup-selected-overlay + (move-overlay gnus-newsgroup-selected-overlay + from to (current-buffer)) + (setq gnus-newsgroup-selected-overlay (make-overlay from to)) + (overlay-put gnus-newsgroup-selected-overlay 'face + gnus-summary-selected-face)))))) + ) + + + ;; New implementation by Christian Limpach . + (defun gnus-visual-summary-highlight-line () + "Highlight current line according to `gnus-visual-summary-highlight'." + (let* ((list gnus-visual-summary-highlight) + (p (point)) + (end (progn (end-of-line) (point))) + ;; now find out where the line starts and leave point there. + (beg (progn (beginning-of-line) (point))) + (score (or (cdr (assq (or (get-text-property beg 'gnus-number) + gnus-current-article) + gnus-newsgroup-scored)) + gnus-summary-default-score 0)) + (default gnus-summary-default-score) + (mark (get-text-property beg 'gnus-mark)) + (inhibit-read-only t)) + (while (and list (not (eval (car (car list))))) + (setq list (cdr list))) + (let ((face (and list (cdr (car list))))) + ;; BUG! For some reason the text properties of the first + ;; characters get mangled. + (or (eq face (get-text-property (+ beg 10) 'face)) + (put-text-property beg end 'face face))) + (goto-char p))) + + (defvar mode-motion-hook nil) + (defun gnus-install-mouse-tracker () + (require 'mode-motion) + (setq mode-motion-hook 'mode-motion-highlight-line)) + + (if (not gnus-xemacs) + () + (setq gnus-group-mode-hook + (cons + (lambda () + (easy-menu-add gnus-group-reading-menu) + (easy-menu-add gnus-group-group-menu) + (easy-menu-add gnus-group-post-menu) + (easy-menu-add gnus-group-misc-menu) + (gnus-install-mouse-tracker)) + gnus-group-mode-hook)) + (setq gnus-summary-mode-hook + (cons + (lambda () + (easy-menu-add gnus-summary-mark-menu) + (easy-menu-add gnus-summary-move-menu) + (easy-menu-add gnus-summary-article-menu) + (easy-menu-add gnus-summary-thread-menu) + (easy-menu-add gnus-summary-misc-menu) + (easy-menu-add gnus-summary-post-menu) + (easy-menu-add gnus-summary-kill-menu) + (gnus-install-mouse-tracker)) + gnus-summary-mode-hook)) + (setq gnus-article-mode-hook + (cons + (lambda () + (easy-menu-add gnus-article-article-menu) + (easy-menu-add gnus-article-treatment-menu)) + gnus-article-mode-hook))) + + (provide 'gnus-vis) + + ;;; gnus-visual.el ends here diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-visual.el dgnus/lisp/gnus-visual.el *** pub/dgnus/lisp/gnus-visual.el Wed Apr 26 17:03:52 1995 --- dgnus/lisp/gnus-visual.el Thu Apr 27 21:40:55 1995 *************** *** 1,500 **** - ;;; gnus-visual: display-oriented parts of Gnus. - ;; Copyright (C) 1995 Free Software Foundation, Inc. - - ;; Author: Lars Magne Ingebrigtsen - ;; Keywords: news - - ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - - ;;; Commentary: - - ;;; Code: - - (require 'gnus) - (require (if gnus-xemacs 'auc-menu 'easymenu)) - - (defvar gnus-summary-selected-face 'underline - "*Face used for highlighting the current article in the summary buffer.") - - (defvar gnus-visual-summary-highlight - '(((> score default) . bold) - ((< score default) . italic)) - "*Alist of `(FORM . FACE)'. - Summary lines are highlighted with the FACE for the first FORM which - evaluate to a non-nil value. - - Point will be at the beginning of the line when FORM is evaluated. - The following can be used for convenience: - - score: (gnus-summary-article-score) - default: gnus-summary-default-score - below: gnus-summary-mark-below - - To check for marks, e.g. to underline replied articles, use - `gnus-summary-article-mark': - - ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)") - - (eval-and-compile - (autoload 'nnkiboze-generate-groups "nnkiboze")) - - ;; Newsgroup buffer - - ;; Make a menu bar item. - (defun gnus-group-make-menu-bar () - (easy-menu-define - gnus-group-reading-menu - gnus-group-mode-map - "" - '("Group" - ["Read" gnus-group-read-group t] - ["Select" gnus-group-select-group t] - ["Catch up" gnus-group-catchup-current t] - ["Catch up all articles" gnus-group-catchup-current-all t] - ["Check for new articles" gnus-group-get-new-news-this-group t] - ["Toggle subscription" gnus-group-unsubscribe-current-group t] - ["Kill" gnus-group-kill-group t] - ["Yank" gnus-group-yank-group t] - ["Describe" gnus-group-describe-group t] - ["Fetch FAQ" gnus-group-fetch-faq t] - ["Edit kill file" gnus-group-edit-local-kill t] - ["Expire articles" gnus-group-expire-articles t] - ["Set group level" gnus-group-set-current-level t] - )) - - (easy-menu-define - gnus-group-group-menu - gnus-group-mode-map - "" - '("Groups" - ("Listing" - ["List subscribed groups" gnus-group-list-groups t] - ["List all groups" gnus-group-list-all-groups t] - ["List groups matching..." gnus-group-list-matching t] - ["List killed groups" gnus-group-list-killed t] - ["List zombie groups" gnus-group-list-zombies t] - ["Describe all groups" gnus-group-describe-all-groups t] - ["Group apropos" gnus-group-apropos t] - ["Group and description apropos" gnus-group-description-apropos t] - ["List groups matching..." gnus-group-list-matching t]) - ("Subscribe" - ["Subscribe to random group" gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region t] - ["Kill all zombie groups" gnus-group-kill-all-zombies t]) - ("Foreign groups" - ["Make a foreign group" gnus-group-make-group t] - ["Edit a group entry" gnus-group-edit-group t] - ["Add a directory group" gnus-group-make-directory-group t] - ["Add the help group" gnus-group-make-help-group t] - ["Add the archive group" gnus-group-make-archive-group t] - ["Make a kiboze group" gnus-group-make-kiboze-group t]) - ["Jump to group" gnus-group-jump-to-group t] - ["Best unread group" gnus-group-best-unread-group t] - )) - - (easy-menu-define - gnus-group-post-menu - gnus-group-mode-map - "" - '("Post" - ["Send a mail" gnus-group-mail t] - ["Post an article" gnus-group-post-news t] - )) - - (easy-menu-define - gnus-group-misc-menu - gnus-group-mode-map - "" - '("Misc" - ["Check for new news" gnus-group-get-new-news t] - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-find-new-newsgroups t] - ["Restart Gnus" gnus-group-restart t] - ["Read init file" gnus-group-read-init-file t] - ["Browse foreign server" gnus-group-browse-foreign-server t] - ["Edit the global kill file" gnus-group-edit-global-kill t] - ["Expire all expirable articles" gnus-group-expire-all-groups t] - ["Generate any kiboze groups" nnkiboze-generate-groups t] - ["Gnus version" gnus-version t] - ["Save .newsrc files" gnus-group-save-newsrc t] - ["Suspend Gnus" gnus-group-suspend t] - ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t] - ["Sort group buffer" gnus-group-sort-groups t] - ["Edit global KILL file" gnus-group-edit-global-kill t] - )) - - ) - - ;; Summary buffer - (defun gnus-summary-make-menu-bar () - - (easy-menu-define - gnus-summary-mark-menu - gnus-summary-mode-map - "" - '("Mark" - ("Read" - ["Mark as read" gnus-summary-mark-as-read-forward t] - ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] - ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] - ["Catchup all" gnus-summary-catchup-all t] - ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup region" gnus-summary-mark-region-as-read t]) - ("Various" - ["Tick" gnus-summary-tick-article-forward t] - ["Mark as dormant" gnus-summary-mark-as-dormant t] - ["Remove marks" gnus-summary-clear-mark-forward t] - ["Set expirable mark" gnus-summary-mark-as-expirable t] - ["Set bookmark" gnus-summary-set-bookmark t] - ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Score" - ["Raise score" gnus-summary-raise-score t] - ["Lower score" gnus-summary-lower-score t] - ["Set score" gnus-summary-set-score t]) - ("Display" - ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t] - ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t] - ["Show dormant articles" gnus-summary-show-all-dormant t] - ["Hide dormant articles" gnus-summary-hide-all-dormant t] - ["Show expunged articles" gnus-summary-show-all-expunged t]) - ("Process mark" - ["Set mark" gnus-summary-mark-as-processable t] - ["Remove mark" gnus-summary-unmark-as-processable t] - ["Remove all marks" gnus-summary-unmark-all-processable t] - ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region t] - ["Mark by regexp" gnus-uu-mark-by-regexp t] - ["Mark all" gnus-uu-mark-all t] - ["Mark sparse" gnus-uu-mark-sparse t] - ["Mark thread" gnus-uu-mark-thread t] - ) - )) - - (easy-menu-define - gnus-summary-move-menu - gnus-summary-mode-map - "" - '("Move" - ["Scroll article forwards" gnus-summary-next-page t] - ["Next unread article" gnus-summary-next-unread-article t] - ["Previous unread article" gnus-summary-prev-unread-article t] - ["Next article" gnus-summary-next-article t] - ["Previous article" gnus-summary-prev-article t] - ["Next article same subject" gnus-summary-next-same-subject t] - ["Previous article same subject" gnus-summary-prev-same-subject t] - ["First unread article" gnus-summary-first-unread-article t] - ["Go to subject number..." gnus-summary-goto-subject t] - ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t] - )) - - (easy-menu-define - gnus-summary-article-menu - gnus-summary-mode-map - "" - '("Article" - ("Hide" - ("Date" - ["Local" gnus-article-date-local t] - ["UT" gnus-article-date-local t] - ["Lapsed" gnus-article-date-local t]) - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["Overstrike" gnus-article-treat-overstrike t] - ["Word wrap" gnus-article-word-wrap t] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu t] - ["Uudecode and save" gnus-uu-decode-uu-and-save t] - ["Unshar" gnus-uu-decode-unshar t] - ["Unshar and save" gnus-uu-decode-unshar-and-save t] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t]) - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article" gnus-summary-isearch-article t] - ["Search all articles" gnus-summary-search-article-forward t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Caesar rotate" gnus-summary-caesar-message t] - ["Redisplay" gnus-summary-show-article t] - ["Toggle header" gnus-summary-toggle-header t] - ["Toggle MIME" gnus-summary-toggle-mime t] - ["Save" gnus-summary-save-article t] - ["Save in mail format" gnus-summary-save-article-mail t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ("Mail articles" - ["Respool article" gnus-summary-respool-article t] - ["Move article" gnus-summary-move-article t] - ["Edit article" gnus-summary-edit-article t] - ["Delete article" gnus-summary-delete-article t]) - )) - - (easy-menu-define - gnus-summary-thread-menu - gnus-summary-mode-map - "" - '("Threads" - ["Toggle threading" gnus-summary-toggle-threads t] - ["Display hidden thread" gnus-summary-show-thread t] - ["Hide thread" gnus-summary-hide-thread t] - ["Go to next thread" gnus-summary-next-thread t] - ["Go to previous thread" gnus-summary-prev-thread t] - ["Go down thread" gnus-summary-down-thread t] - ["Go up thread" gnus-summary-up-thread t] - ["Mark thread as read" gnus-summary-kill-thread t] - ["Lower thread score" gnus-summary-lower-thread t] - ["Raise thread score" gnus-summary-raise-thread t] - )) - - (easy-menu-define - gnus-summary-misc-menu - gnus-summary-mode-map - "" - '("Misc" - ("Sort" - ["Sort by number" gnus-summary-sort-by-number t] - ["Sort by author" gnus-summary-sort-by-author t] - ["Sort by subject" gnus-summary-sort-by-subject t] - ["Sort by date" gnus-summary-sort-by-date t]) - ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] - ["Exit group without updating" gnus-summary-quit t] - ["Reselect group" gnus-summary-reselect-current-group t] - ["Rescan group" gnus-summary-rescan-group t]) - ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Filter articles" gnus-summary-execute-command t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expire expirable articles" gnus-summary-expire-articles t] - ["Describe group" gnus-summary-describe-group t] - ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit global kill file" gnus-summary-edit-global-kill t] - )) - - (easy-menu-define - gnus-summary-post-menu - gnus-summary-mode-map - "" - '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] - ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] - ["Reply" gnus-summary-reply t] - ["Reply and yank" gnus-summary-reply-with-original t] - ["Mail forward" gnus-summary-mail-forward t] - ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] - ["Send a mail" gnus-summary-mail-other-window t] - ["Reply & followup" gnus-summary-followup-and-reply t] - ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] - ["Uuencode and post" gnus-uu-post-news t] - )) - - (easy-menu-define - gnus-summary-kill-menu - gnus-summary-mode-map - "" - '("Score" - ("Score file" - ["Switch current score file" gnus-score-change-score-file t] - ["Set mark below" gnus-score-set-mark-below t] - ["Set expunge below" gnus-score-set-expunge-below t] - ["Edit current score file" gnus-score-edit-alist t] - ["Edit score file" gnus-score-edit-file t]) - ["Raise score with current subject" - gnus-summary-temporarily-raise-by-subject t] - ["Raise score with current author" - gnus-summary-temporarily-raise-by-author t] - ["Raise score with current thread" - gnus-summary-temporarily-raise-by-thread t] - ["Raise score with current crossposting" - gnus-summary-temporarily-raise-by-xref t] - ["Permanently raise score with current subject" - gnus-summary-raise-by-subject t] - ["Permanently raise score with current author" - gnus-summary-raise-by-author t] - ["Permanently raise score with current crossposting" - gnus-summary-raise-by-xref t] - ["Permanently raise score for followups to current author" - gnus-summary-raise-followups-to-author t] - ["Lower score with current subject" - gnus-summary-temporarily-lower-by-subject t] - ["Lower score with current author" - gnus-summary-temporarily-lower-by-author t] - ["Lower score with current thread" - gnus-summary-temporarily-lower-by-thread t] - ["Lower score with current crossposting" - gnus-summary-temporarily-lower-by-xref t] - ["Permanently lower score with current subject" - gnus-summary-lower-by-subject t] - ["Permanently lower score with current author" - gnus-summary-lower-by-author t] - ["Permanently lower score with current crossposting" - gnus-summary-lower-by-xref t] - ["Permanently lower score for followups to current author" - gnus-summary-lower-followups-to-author t] - )) - ) - - ;; Article buffer - (defun gnus-article-make-menu-bar () - - (easy-menu-define - gnus-article-article-menu - gnus-article-mode-map - "" - '("Article" - ["Scroll forwards" gnus-article-next-page t] - ["Scroll backwards" gnus-article-prev-page t] - ["Show summary" gnus-article-show-summary t] - ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t] - ["Mail to address at point and include original" - gnus-article-mail-with-original t] - )) - - (easy-menu-define - gnus-article-treatment-menu - gnus-article-mode-map - "" - '("Treatment" - ["Hide headers" gnus-article-hide-headers t] - ["Hide signature" gnus-article-hide-signature t] - ["Hide citation" gnus-article-hide-citation t] - ["Treat overstrike" gnus-article-treat-overstrike t] - ["Remove carriage return" gnus-article-remove-cr t] - ["Remove quoted-unreadble" gnus-article-de-quoted-unreadable t] - )) - ) - - (if gnus-xemacs - (defun gnus-visual-highlight-selected-summary () - (if gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - (from (or - (next-single-property-change beg 'mouse-face nil end) - beg)) - (to (or (next-single-property-change from 'mouse-face nil end) - end))) - (if gnus-newsgroup-selected-overlay - (move-overlay gnus-newsgroup-selected-overlay - from to (current-buffer)) - (setq gnus-newsgroup-selected-overlay (make-overlay from to)) - (overlay-put gnus-newsgroup-selected-overlay 'face - gnus-summary-selected-face)))))) - - (defun gnus-visual-highlight-selected-summary () - ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer - (if gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - (to (max 1 (1- (previous-single-property-change - end 'mouse-face nil beg)))) - (from (1+ (next-single-property-change - beg 'mouse-face nil end)))) - (if (< to beg) - (progn - (setq from beg) - (setq to end))) - (if gnus-newsgroup-selected-overlay - (move-overlay gnus-newsgroup-selected-overlay - from to (current-buffer)) - (setq gnus-newsgroup-selected-overlay (make-overlay from to)) - (overlay-put gnus-newsgroup-selected-overlay 'face - gnus-summary-selected-face)))))) - ) - - - ;; New implementation by Christian Limpach . - (defun gnus-visual-summary-highlight-line () - "Highlight current line according to `gnus-visual-summary-highlight'." - (let* ((list gnus-visual-summary-highlight) - (p (point)) - (end (progn (end-of-line) (point))) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (score (or (cdr (assq (or (get-text-property beg 'gnus-number) - gnus-current-article) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (default gnus-summary-default-score) - (mark (get-text-property beg 'gnus-mark)) - (inhibit-read-only t)) - (while (and list (not (eval (car (car list))))) - (setq list (cdr list))) - (let ((face (and list (cdr (car list))))) - ;; BUG! For some reason the text properties of the first - ;; characters get mangled. - (or (eq face (get-text-property (+ beg 10) 'face)) - (put-text-property beg end 'face face))) - (goto-char p))) - - (defvar mode-motion-hook nil) - (defun gnus-install-mouse-tracker () - (require 'mode-motion) - (setq mode-motion-hook 'mode-motion-highlight-line)) - - (if (not gnus-xemacs) - () - (setq gnus-group-mode-hook - (cons - (lambda () - (easy-menu-add gnus-group-reading-menu) - (easy-menu-add gnus-group-group-menu) - (easy-menu-add gnus-group-post-menu) - (easy-menu-add gnus-group-misc-menu) - (gnus-install-mouse-tracker)) - gnus-group-mode-hook)) - (setq gnus-summary-mode-hook - (cons - (lambda () - (easy-menu-add gnus-summary-mark-menu) - (easy-menu-add gnus-summary-move-menu) - (easy-menu-add gnus-summary-article-menu) - (easy-menu-add gnus-summary-thread-menu) - (easy-menu-add gnus-summary-misc-menu) - (easy-menu-add gnus-summary-post-menu) - (easy-menu-add gnus-summary-kill-menu) - (gnus-install-mouse-tracker)) - gnus-summary-mode-hook)) - (setq gnus-article-mode-hook - (cons - (lambda () - (easy-menu-add gnus-article-article-menu) - (easy-menu-add gnus-article-treatment-menu)) - gnus-article-mode-hook))) - - (provide 'gnus-visual) - - ;;; gnus-visual.el ends here --- 0 ---- diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus.el dgnus/lisp/gnus.el *** pub/dgnus/lisp/gnus.el Wed Apr 26 17:03:54 1995 --- dgnus/lisp/gnus.el Fri Apr 28 01:06:36 1995 *************** *** 1314,1320 **** (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.60" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1314,1320 ---- (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.61" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1519,1525 **** (autoload 'mail-setup "sendmail") (autoload 'news-mail-other-window "rnewspost") (autoload 'news-reply-yank-original "rnewspost") ! (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail") --- 1519,1526 ---- (autoload 'mail-setup "sendmail") (autoload 'news-mail-other-window "rnewspost") (autoload 'news-reply-yank-original "rnewspost") ! (autoload 'news-caesar-buffer-body "rnewspost") ! (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail") *************** *** 1531,1541 **** (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ! (autoload 'gnus-group-make-menu-bar "gnus-visual") ! (autoload 'gnus-summary-make-menu-bar "gnus-visual") ! (autoload 'gnus-article-make-menu-bar "gnus-visual") ! (autoload 'gnus-visual-highlight-selected-summary "gnus-visual") ! (autoload 'gnus-visual-summary-highlight-line "gnus-visual") (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t) (autoload 'gnus-uu-mark-region "gnus-uu" nil t) --- 1532,1542 ---- (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ! (autoload 'gnus-group-make-menu-bar "gnus-vis") ! (autoload 'gnus-summary-make-menu-bar "gnus-vis") ! (autoload 'gnus-article-make-menu-bar "gnus-vis") ! (autoload 'gnus-visual-highlight-selected-summary "gnus-vis") ! (autoload 'gnus-visual-summary-highlight-line "gnus-vis") (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t) (autoload 'gnus-uu-mark-region "gnus-uu" nil t) *************** *** 1584,1610 **** (autoload 'gnus-score-adaptive "gnus-score") (autoload 'gnus-score-remove-lines-adaptive "gnus-score") ! (autoload 'gnus-summary-send-map "gnus-message" nil nil 'keymap) ! (autoload 'gnus-group-post-news "gnus-message" nil t) ! (autoload 'gnus-summary-post-news "gnus-message" nil t) ! (autoload 'gnus-summary-followup "gnus-message" nil t) ! (autoload 'gnus-summary-followup-with-original "gnus-message" nil t) ! (autoload 'gnus-summary-followup-and-reply "gnus-message" nil t) ! (autoload 'gnus-summary-followup-and-reply-with-original "gnus-message" nil t) ! (autoload 'gnus-summary-cancel-article "gnus-message" nil t) ! (autoload 'gnus-summary-supersede-article "gnus-message" nil t) ! (autoload 'gnus-post-news "gnus-message" nil t) ! (autoload 'gnus-inews-news "gnus-message" nil t) ! (autoload 'gnus-cancel-news "gnus-message" nil t) ! (autoload 'gnus-summary-reply "gnus-message" nil t) ! (autoload 'gnus-summary-reply-with-original "gnus-message" nil t) ! (autoload 'gnus-summary-mail-forward "gnus-message" nil t) ! (autoload 'gnus-summary-mail-other-window "gnus-message" nil t) ! (autoload 'gnus-mail-reply-using-mail "gnus-message") ! (autoload 'gnus-mail-yank-original "gnus-message") ! (autoload 'gnus-mail-send-and-exit "gnus-message") ! (autoload 'gnus-mail-forward-using-mail "gnus-message") ! (autoload 'gnus-mail-other-window-using-mail "gnus-message") ) --- 1585,1611 ---- (autoload 'gnus-score-adaptive "gnus-score") (autoload 'gnus-score-remove-lines-adaptive "gnus-score") ! (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap) ! (autoload 'gnus-group-post-news "gnus-msg" nil t) ! (autoload 'gnus-summary-post-news "gnus-msg" nil t) ! (autoload 'gnus-summary-followup "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-and-reply "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-and-reply-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-cancel-article "gnus-msg" nil t) ! (autoload 'gnus-summary-supersede-article "gnus-msg" nil t) ! (autoload 'gnus-post-news "gnus-msg" nil t) ! (autoload 'gnus-inews-news "gnus-msg" nil t) ! (autoload 'gnus-cancel-news "gnus-msg" nil t) ! (autoload 'gnus-summary-reply "gnus-msg" nil t) ! (autoload 'gnus-summary-reply-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-mail-forward "gnus-msg" nil t) ! (autoload 'gnus-summary-mail-other-window "gnus-msg" nil t) ! (autoload 'gnus-mail-reply-using-mail "gnus-msg") ! (autoload 'gnus-mail-yank-original "gnus-msg") ! (autoload 'gnus-mail-send-and-exit "gnus-msg") ! (autoload 'gnus-mail-forward-using-mail "gnus-msg") ! (autoload 'gnus-mail-other-window-using-mail "gnus-msg") ) *************** *** 2491,2507 **** (yes-or-no-p prompt) (message ""))) - ;; Return a string of length POS+1 representing NUMber in reverse - ;; BASE. The resulting string will be left padded with zeds. - (defun gnus-number-base-x (num pos base) - (if (< pos 0) - "" - (concat - (char-to-string - (aref "zyxwvutsrqponmlkjihgfedcba9876543210" (/ num (expt base pos)))) - (gnus-number-base-x - (% num (expt base pos)) (1- pos) base)))) - ;; Check whether to use long file names. (defun gnus-use-long-file-name (symbol) ;; The variable has to be set... --- 2492,2497 ---- *************** *** 3325,3330 **** --- 3315,3321 ---- (or visible-only (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb)))) (while (and entry + (car entry) (not (gnus-goto-char (text-property-any *************** *** 3593,3602 **** (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func (lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done 'part 'group))) (part (or part 'info)) info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) --- 3584,3593 ---- (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func '(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done 'part 'group))) (part (or part 'info)) info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) *************** *** 4037,4051 **** specify which levels you are interested in re-scanning." (interactive "P") (run-hooks 'gnus-get-new-news-hook) ! (if (and gnus-read-active-file (not arg)) ! (progn ! (gnus-read-active-file) ! (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))) ! (let ((gnus-read-active-file nil)) ! (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))) ! (gnus-group-list-groups ! (or gnus-group-always-list-unread arg gnus-level-subscribed) ! gnus-have-all-newsgroups)) (defun gnus-group-get-new-news-this-group (n) "Check for newly arrived news in the current group (and the N-1 next groups). --- 4028,4043 ---- specify which levels you are interested in re-scanning." (interactive "P") (run-hooks 'gnus-get-new-news-hook) ! (let ((level arg)) ! (if (and gnus-read-active-file (not level)) ! (progn ! (gnus-read-active-file) ! (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))) ! (let ((gnus-read-active-file nil)) ! (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))) ! (gnus-group-list-groups ! (or gnus-group-always-list-unread level gnus-level-subscribed) ! gnus-have-all-newsgroups))) (defun gnus-group-get-new-news-this-group (n) "Check for newly arrived news in the current group (and the N-1 next groups). *************** *** 4533,4540 **** (defvar gnus-summary-interest-map nil) (defvar gnus-summary-process-map nil) (defvar gnus-summary-sort-map nil) ! (defvar gnus-summary-mgroup-map nil) ! (defvar gnus-summary-vsave-map nil) (put 'gnus-summary-mode 'mode-class 'special) --- 4525,4534 ---- (defvar gnus-summary-interest-map nil) (defvar gnus-summary-process-map nil) (defvar gnus-summary-sort-map nil) ! (defvar gnus-summary-backend-map nil) ! (defvar gnus-summary-save-map nil) ! (defvar gnus-summary-wash-map nil) ! (defvar gnus-summary-help-map nil) (put 'gnus-summary-mode 'mode-class 'special) *************** *** 4725,4730 **** --- 4719,4726 ---- (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit) (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit) (define-key gnus-summary-exit-map "n" 'gnus-summary-catchup-and-goto-next-group) + (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group) + (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group) (define-prefix-command 'gnus-summary-article-map) *************** *** 4744,4764 **** (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message) (define-key gnus-summary-article-map "g" 'gnus-summary-show-article) (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header) - (define-key gnus-summary-article-map "hh" 'gnus-article-hide-headers) - (define-key gnus-summary-article-map "hs" 'gnus-article-hide-signature) - (define-key gnus-summary-article-map "hc" 'gnus-article-hide-citation) - (define-key gnus-summary-article-map "ho" 'gnus-article-treat-overstrike) - (define-key gnus-summary-article-map "hw" 'gnus-article-word-wrap) - (define-key gnus-summary-article-map "hd" 'gnus-article-remove-cr) - (define-key gnus-summary-article-map "hq" 'gnus-article-de-quoted-unreadable) - (define-key gnus-summary-article-map "hf" 'gnus-article-display-x-face) - (define-key gnus-summary-article-map "ht" 'gnus-article-date-ut) - (define-key gnus-summary-article-map "h\C-t" 'gnus-article-date-local) - (define-key gnus-summary-article-map "hT" 'gnus-article-date-lapsed) (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime) (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article) (define-prefix-command 'gnus-summary-extract-map) (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map) ; (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any) --- 4740,4793 ---- (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message) (define-key gnus-summary-article-map "g" 'gnus-summary-show-article) (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header) (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime) (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article) + (define-prefix-command 'gnus-summary-wash-map) + (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map) + (define-key gnus-summary-wash-map "h" 'gnus-article-hide-headers) + (define-key gnus-summary-wash-map "s" 'gnus-article-hide-signature) + (define-key gnus-summary-wash-map "c" 'gnus-article-hide-citation) + (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) + (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap) + (define-key gnus-summary-wash-map "d" 'gnus-article-remove-cr) + (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable) + (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face) + (define-key gnus-summary-wash-map "t" 'gnus-article-date-ut) + (define-key gnus-summary-wash-map "\C-t" 'gnus-article-date-local) + (define-key gnus-summary-wash-map "T" 'gnus-article-date-lapsed) + + + (define-prefix-command 'gnus-summary-help-map) + (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map) + (define-key gnus-summary-help-map "v" 'gnus-version) + (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq) + (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group) + (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly) + (define-key gnus-summary-help-map "i" 'gnus-info-find-node) + + + (define-prefix-command 'gnus-summary-backend-map) + (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map) + (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles) + (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article) + (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article) + (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article) + (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article) + (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article) + + + (define-prefix-command 'gnus-summary-save-map) + (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map) + (define-key gnus-summary-save-map "o" 'gnus-summary-save-article) + (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail) + (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail) + (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file) + (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) + (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) + + (define-prefix-command 'gnus-summary-extract-map) (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map) ; (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any) *************** *** 4798,4823 **** (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command) (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation) (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window) - (define-key gnus-summary-various-map "S" 'gnus-summary-reselect-current-group) - (define-key gnus-summary-various-map "g" 'gnus-summary-rescan-group) - (define-key gnus-summary-various-map "V" 'gnus-version) - (define-key gnus-summary-various-map "f" 'gnus-summary-fetch-faq) - (define-key gnus-summary-various-map "d" 'gnus-summary-describe-group) - (define-key gnus-summary-various-map "?" 'gnus-summary-describe-briefly) - (define-key gnus-summary-various-map "i" 'gnus-info-find-node) (define-key gnus-summary-various-map "D" 'gnus-summary-enter-digest-group) (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill) (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill) - (define-prefix-command 'gnus-summary-vsave-map) - (define-key gnus-summary-various-map "o" 'gnus-summary-vsave-map) - (define-key gnus-summary-vsave-map "o" 'gnus-summary-save-article) - (define-key gnus-summary-vsave-map "m" 'gnus-summary-save-article-mail) - (define-key gnus-summary-vsave-map "r" 'gnus-summary-save-article-rmail) - (define-key gnus-summary-vsave-map "f" 'gnus-summary-save-article-file) - (define-key gnus-summary-vsave-map "h" 'gnus-summary-save-article-folder) - (define-key gnus-summary-vsave-map "p" 'gnus-summary-pipe-output) - (define-key gnus-summary-various-map "S" 'gnus-summary-score-map) (define-prefix-command 'gnus-summary-sort-map) --- 4827,4836 ---- *************** *** 4828,4842 **** (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date) (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score) - (define-prefix-command 'gnus-summary-mgroup-map) - (define-key gnus-summary-various-map "m" 'gnus-summary-mgroup-map) - (define-key gnus-summary-mgroup-map "e" 'gnus-summary-expire-articles) - (define-key gnus-summary-mgroup-map "\177" 'gnus-summary-delete-article) - (define-key gnus-summary-mgroup-map "m" 'gnus-summary-move-article) - (define-key gnus-summary-mgroup-map "r" 'gnus-summary-respool-article) - (define-key gnus-summary-mgroup-map "w" 'gnus-summary-edit-article) - (define-key gnus-summary-mgroup-map "c" 'gnus-summary-copy-article) - (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-map) (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-map) ) --- 4841,4846 ---- *************** *** 5040,5045 **** --- 5044,5051 ---- (gnus-group-next-unread-group 1))) nil) ((eq did-select 'quit) + (gnus-configure-windows 'summary) + (gnus-configure-windows 'newsgroup) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) *************** *** 5854,5868 **** (- (frame-width) gnus-mode-non-string-length))) header) ;; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) ! (if (< max-len 4) (setq max-len 4)) ! (and (numberp max-len) ! (progn ! (if (> (length mode-string) max-len) ! (setq mode-string ! (concat (substring mode-string 0 (- max-len 3)) ! "..."))) ! (setq mode-string (format (format "%%-%ds" max-len) ! mode-string)))))) (setq mode-line-buffer-identification mode-string) (set-buffer-modified-p t)))) --- 5860,5874 ---- (- (frame-width) gnus-mode-non-string-length))) header) ;; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) ! (or (numberp max-len) ! (setq max-len (length mode-string))) ! (if (< max-len 4) (setq max-len 4)) ! (if (> (length mode-string) max-len) ! (setq mode-string ! (concat (substring mode-string 0 (- max-len 3)) ! "..."))) ! (setq mode-string (format (format "%%-%ds" max-len) ! mode-string)))) (setq mode-line-buffer-identification mode-string) (set-buffer-modified-p t)))) *************** *** 6696,6703 **** (bury-buffer gnus-article-buffer)) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) ! (gnus-group-jump-to-group group) ! (gnus-group-next-group 1) (if (gnus-buffer-exists-p quit-buffer) (progn (switch-to-buffer quit-buffer) --- 6702,6711 ---- (bury-buffer gnus-article-buffer)) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) ! (if (eq method 'nndigest) ! () ! (gnus-group-jump-to-group group) ! (gnus-group-next-group 1)) (if (gnus-buffer-exists-p quit-buffer) (progn (switch-to-buffer quit-buffer) *************** *** 6968,6974 **** gnus-newsgroup-end))) ;; Go to next/previous group. (t ! (gnus-summary-jump-to-group gnus-newsgroup-name) (let ((cmd (aref (this-command-keys) 0)) (group (if (eq gnus-keep-same-level 'best) --- 6976,6983 ---- gnus-newsgroup-end))) ;; Go to next/previous group. (t ! (or (eq method 'nndigest) ! (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd (aref (this-command-keys) 0)) (group (if (eq gnus-keep-same-level 'best) *************** *** 9541,9546 **** --- 9550,9556 ---- processing, but is simply a stop-gap measure until MIME support is written." ;; Unquote quoted-printable from news articles. + (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((case-fold-search t) *************** *** 11491,11496 **** --- 11501,11507 ---- (let ((subscribe nil) (read-list nil) (line (1+ (count-lines (point-min) (point)))) + (already-read (> (length gnus-newsrc-alist) 1)) newsgroup p p2) (save-restriction *************** *** 11591,11605 **** (cons (list newsgroup (if subscribe gnus-level-default-subscribed ! (if read-list gnus-level-default-subscribed ! (1+ gnus-level-default-subscribed))) (nreverse read-list)) gnus-newsrc-alist)))))) (setq line (1+ line)) ! (forward-line 1)))) ! (setq gnus-newsrc-alist (cdr gnus-newsrc-alist)) ! (gnus-make-hashtable-from-newsrc-alist) ! nil) (defun gnus-parse-n-options (options) "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps." --- 11602,11618 ---- (cons (list newsgroup (if subscribe gnus-level-default-subscribed ! (if read-list ! (1+ gnus-level-default-subscribed) ! gnus-level-default-unsubscribed)) (nreverse read-list)) gnus-newsrc-alist)))))) (setq line (1+ line)) ! (forward-line 1))) ! (setq gnus-newsrc-alist (cdr gnus-newsrc-alist)) ! (and already-read (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! (gnus-make-hashtable-from-newsrc-alist) ! nil)) (defun gnus-parse-n-options (options) "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps." diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnfolder.el dgnus/lisp/nnfolder.el *** pub/dgnus/lisp/nnfolder.el Wed Apr 26 17:03:54 1995 --- dgnus/lisp/nnfolder.el Thu Apr 27 23:52:33 1995 *************** *** 212,233 **** (save-excursion (nnfolder-possibly-change-group group) (and (assoc group nnfolder-group-alist) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) (if dont-check t ! (nnfolder-get-new-mail) ! (let ((active (assoc group nnfolder-group-alist))) ! ;; I've been getting stray 211 lines in my nnfolder active ! ;; file. So, let's make sure that doesn't happen. -SLB ! (set-buffer nntp-server-buffer) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) t))))) ;; Don't close the buffer if we're not shutting down the server. This way, --- 212,233 ---- (save-excursion (nnfolder-possibly-change-group group) (and (assoc group nnfolder-group-alist) ! (progn (if dont-check t ! (nnfolder-get-new-mail)) ! (let* ((active (assoc group nnfolder-group-alist)) ! (group (car active)) ! (range (car (cdr active))) ! (minactive (car range)) ! (maxactive (cdr range))) ! ;; I've been getting stray 211 lines in my nnfolder active ! ;; file. So, let's make sure that doesn't happen. -SLB ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- maxactive minactive)) ! minactive maxactive group)) t))))) ;; Don't close the buffer if we're not shutting down the server. This way, *************** *** 240,246 **** (save-excursion (set-buffer nnfolder-current-buffer) ;; If the buffer was modified, write the file out now. ! (save-buffer) (if (or force nnfolder-always-close) ;; If we're shutting the server down, we need to kill the buffer and --- 240,246 ---- (save-excursion (set-buffer nnfolder-current-buffer) ;; If the buffer was modified, write the file out now. ! (and (buffer-modified-p) (save-buffer)) (if (or force nnfolder-always-close) ;; If we're shutting the server down, we need to kill the buffer and *************** *** 297,303 **** (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (save-buffer) ;; Find the lowest active article in this group. (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist)))) (marker (concat "\n" nnfolder-article-marker)) --- 297,303 ---- (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (and (buffer-modified-p) (save-buffer)) ;; Find the lowest active article in this group. (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist)))) (marker (concat "\n" nnfolder-article-marker)) *************** *** 341,347 **** (goto-char 1) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last (save-buffer)))) result)) (defun nnfolder-request-accept-article (group &optional last) --- 341,349 ---- (goto-char 1) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last ! (buffer-modified-p) ! (save-buffer)))) result)) (defun nnfolder-request-accept-article (group &optional last) *************** *** 365,371 **** (save-excursion (set-buffer nnfolder-current-buffer) (insert-buffer-substring buf) ! (and last (save-buffer)) result) (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) result)) --- 367,373 ---- (save-excursion (set-buffer nnfolder-current-buffer) (insert-buffer-substring buf) ! (and last (buffer-modified-p) (save-buffer)) result) (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) result)) *************** *** 379,385 **** nil (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (save-buffer) t))) --- 381,387 ---- nil (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (and (buffer-modified-p) (save-buffer)) t))) *************** *** 464,489 **** (nnmail-insert-lines) (nnmail-insert-xref group-art-list) - ;; Kill the previous newsgroup markers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Insert the mail into each of the destination groups. (while group-art-list (setq group-art (car group-art-list) group-art-list (cdr group-art-list)) (nnfolder-possibly-change-group (car group-art)) (nnfolder-insert-newsgroup-line group-art) (let ((beg (point-min)) (end (point-max)) (obuf (current-buffer))) ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-max)) ! (insert-buffer-substring obuf beg end)))) ;; Did we save it anywhere? save-list)) --- 466,493 ---- (nnmail-insert-lines) (nnmail-insert-xref group-art-list) ;; Insert the mail into each of the destination groups. (while group-art-list (setq group-art (car group-art-list) group-art-list (cdr group-art-list)) + + ;; Kill the previous newsgroup markers. + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (forward-line -1) + (while (search-backward (concat "\n" nnfolder-article-marker) nil t) + (delete-region (point) (progn (forward-line 1) (point)))) + + ;; Insert the new newsgroup marker. (nnfolder-possibly-change-group (car group-art)) (nnfolder-insert-newsgroup-line group-art) (let ((beg (point-min)) (end (point-max)) (obuf (current-buffer))) ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-max)) ! (insert-buffer-substring obuf beg end) ! (set-buffer obuf))) ;; Did we save it anywhere? save-list)) *************** *** 555,563 **** (1- (lsh 1 25)))) (while (and (search-forward marker nil t) (re-search-forward number nil t)) ! (let (newnum (string-to-number (buffer-substring (match-beginning 0) ! (match-end 0)))) (setq activenumber (max activenumber newnum)) (setq activemin (min activemin newnum)))) (setcar active (min activemin activenumber)) --- 559,567 ---- (1- (lsh 1 25)))) (while (and (search-forward marker nil t) (re-search-forward number nil t)) ! (let ((newnum (string-to-number (buffer-substring (match-beginning 0) ! (match-end 0))))) (setq activenumber (max activenumber newnum)) (setq activemin (min activemin newnum)))) (setcar active (min activemin activenumber)) *************** *** 616,623 **** (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) ! (and (buffer-modified-p) ! (save-buffer))) (setq bufs (cdr bufs))))) ;; (if incoming (delete-file incoming)) )) --- 620,626 ---- (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) ! (and (buffer-modified-p) (save-buffer))) (setq bufs (cdr bufs))))) ;; (if incoming (delete-file incoming)) )) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnmail.el dgnus/lisp/nnmail.el *** pub/dgnus/lisp/nnmail.el Wed Apr 26 17:03:54 1995 --- dgnus/lisp/nnmail.el Fri Apr 28 00:44:58 1995 *************** *** 128,134 **** (defun nnmail-request-post-buffer (post group subject header article-buffer info follow-to respect-poster) ! (let ((method-address (cdr (assq 'to-address (nth 4 info)))) from subject date to reply-to message-of references message-id sender cc sendto elt) (setq method-address --- 128,134 ---- (defun nnmail-request-post-buffer (post group subject header article-buffer info follow-to respect-poster) ! (let ((method-address (cdr (assq 'to-address (nth 5 info)))) from subject date to reply-to message-of references message-id sender cc sendto elt) (setq method-address diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnspool.el dgnus/lisp/nnspool.el *** pub/dgnus/lisp/nnspool.el Wed Apr 26 17:03:54 1995 --- dgnus/lisp/nnspool.el Thu Apr 27 22:19:51 1995 *************** *** 126,143 **** 'nov (while sequence (setq article (car sequence)) ! (setq file (concat nnspool-current-directory ! (int-to-string article))) ! (and (file-exists-p file) ! (progn ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (insert-file-contents file) ! (goto-char beg) ! (search-forward "\n\n" nil t) ! (forward-char -1) ! (insert ".\n") ! (delete-region (point) (point-max)))) (setq sequence (cdr sequence)) (and do-message --- 126,147 ---- 'nov (while sequence (setq article (car sequence)) ! (if (stringp article) ! (progn ! (format "221 %d Article retrieved.\n" 0) ! (nnspool-request-article article)) ! (setq file (concat nnspool-current-directory ! (int-to-string article))) ! (and (file-exists-p file) ! (progn ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (insert-file-contents file) ! (goto-char beg) ! (search-forward "\n\n" nil t) ! (forward-char -1) ! (insert ".\n") ! (delete-region (point) (point-max))))) (setq sequence (cdr sequence)) (and do-message diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/texi/gnus.texi dgnus/texi/gnus.texi *** pub/dgnus/texi/gnus.texi Wed Apr 26 17:04:03 1995 --- dgnus/texi/gnus.texi Thu Apr 27 22:51:08 1995 *************** *** 3773,3778 **** --- 3773,3792 ---- @findex gnus-summary-catchup-and-goto-next-group Mark all articles as read and go to the next group (@code{gnus-summary-catchup-and-goto-next-group}). + @item Z R + @kindex Z R (Summary) + @findex gnus-summary-reselect-current-group + Exit this group, and then enter it again + (@code{gnus-summary-reselect-current-group}). If given a prefix, select + all articles, both read and unread. + @item Z G + @itemx M-g + @kindex Z G (Summary) + @kindex M-g (Summary) + @findex gnus-summary-rescan-group + Exit the group, check for new articles in the group, and select the + group (@code{gnus-summary-rescan-group}). If given a prefix, select all + articles, both read and unread. @end table @vindex gnus-exit-group-hook *************** *** 3859,3893 **** unwanted headers before saving the article. @table @kbd ! @item V o o @itemx o ! @kindex V o o (Summary) @kindex o (Summary) @findex gnus-summary-save-article Save the current article using the default article saver (@code{gnus-summary-save-article}). ! @item V o m ! @kindex V o m (Summary) @findex gnus-summary-save-article-mail Save the current article in mail format (@code{gnus-summary-save-article-mail}). ! @item V o r ! @kindex V o r (Summary) @findex gnus-summary-save-article-mail Save the current article in rmail format (@code{gnus-summary-save-article-rmail}). ! @item V o f ! @kindex V o f (Summary) @findex gnus-summary-save-article-file Save the current article in plain file format (@code{gnus-summary-save-article-file}). ! @item V o h ! @kindex V o h (Summary) @findex gnus-summary-save-article-folder Save the current article in mh folder format (@code{gnus-summary-save-article-folder}). ! @item V o p ! @kindex V o p (Summary) @findex gnus-summary-pipe-output Save the current article in a pipe. Uhm, like, what I mean is - Pipe the current article to a process (@code{gnus-summary-pipe-output}). --- 3873,3907 ---- unwanted headers before saving the article. @table @kbd ! @item O o @itemx o ! @kindex O o (Summary) @kindex o (Summary) @findex gnus-summary-save-article Save the current article using the default article saver (@code{gnus-summary-save-article}). ! @item O m ! @kindex O m (Summary) @findex gnus-summary-save-article-mail Save the current article in mail format (@code{gnus-summary-save-article-mail}). ! @item O r ! @kindex O r (Summary) @findex gnus-summary-save-article-mail Save the current article in rmail format (@code{gnus-summary-save-article-rmail}). ! @item O f ! @kindex O f (Summary) @findex gnus-summary-save-article-file Save the current article in plain file format (@code{gnus-summary-save-article-file}). ! @item O h ! @kindex O h (Summary) @findex gnus-summary-save-article-folder Save the current article in mh folder format (@code{gnus-summary-save-article-folder}). ! @item O p ! @kindex O p (Summary) @findex gnus-summary-pipe-output Save the current article in a pipe. Uhm, like, what I mean is - Pipe the current article to a process (@code{gnus-summary-pipe-output}). *************** *** 4321,4356 **** There's a battery of commands for washing the article buffer: @table @kbd ! @item A h h ! @kindex A h h (Summary) @findex gnus-article-hide-headers Hide headers (@code{gnus-article-hide-headers}). ! @item A h s ! @kindex A h s (Summary) @findex gnus-article-hide-signature Hide signature (@code{gnus-article-hide-signature}). ! @item A h c ! @kindex A h c (Summary) @findex gnus-article-hide-citation Hide citation (@code{gnus-article-hide-citation}). ! @item A h o ! @kindex A h o (Summary) @findex gnus-article-treat-overstrike Treat overstrike (@code{gnus-article-treat-overstrike}). ! @item A h w ! @kindex A h w (Summary) @findex gnus-article-word-wrap Do word wrap (@code{gnus-article-word-wrap}). ! @item A h d ! @kindex A h d (Summary) @findex gnus-article-remove-cr Remove CR (@code{gnus-article-remove-cr}). ! @item A h q ! @kindex A h q (Summary) @findex gnus-article-de-quoted-unreadable Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). ! @item A h f ! @kindex A h f (Summary) @findex gnus-article-display-x-face @findex gnus-article-x-face-command Look for and display any X-Face headers --- 4335,4370 ---- There's a battery of commands for washing the article buffer: @table @kbd ! @item W h ! @kindex W h (Summary) @findex gnus-article-hide-headers Hide headers (@code{gnus-article-hide-headers}). ! @item W s ! @kindex W s (Summary) @findex gnus-article-hide-signature Hide signature (@code{gnus-article-hide-signature}). ! @item W c ! @kindex W c (Summary) @findex gnus-article-hide-citation Hide citation (@code{gnus-article-hide-citation}). ! @item W o ! @kindex W o (Summary) @findex gnus-article-treat-overstrike Treat overstrike (@code{gnus-article-treat-overstrike}). ! @item W w ! @kindex W w (Summary) @findex gnus-article-word-wrap Do word wrap (@code{gnus-article-word-wrap}). ! @item W d ! @kindex W d (Summary) @findex gnus-article-remove-cr Remove CR (@code{gnus-article-remove-cr}). ! @item W q ! @kindex W q (Summary) @findex gnus-article-de-quoted-unreadable Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). ! @item W f ! @kindex W f (Summary) @findex gnus-article-display-x-face @findex gnus-article-x-face-command Look for and display any X-Face headers *************** *** 5157,5190 **** process/prefix convention (@pxref{Process/Prefix}). @table @kbd ! @item V m e ! @kindex V m e (Summary) @findex gnus-summary-expire-articles Expire all expirable articles in the group (@code{gnus-summary-expire-articles}). ! @item V m DEL ! @kindex V m DEL (Summary) @findex gnus-summary-delete-articles Delete the mail article. This is "delete" as in "delete it from your disk forever and ever, never to return again." Use with caution. (@code{gnus-summary-delete-article}). ! @item V m m ! @kindex V m m (Summary) @findex gnus-summary-move-article Move the article from one mail group to another (@code{gnus-summary-move-article}). ! @item V m c ! @kindex V m c (Summary) @findex gnus-summary-copy-article Copy the article from one group (mail group or not) to a mail group (@code{gnus-summary-copy-article}). ! @item V m r ! @kindex V m r (Summary) @findex gnus-summary-respool-article Respool the mail article (@code{gnus-summary-move-article}). ! @item V m w @itemx e ! @kindex V m w (Summary) @kindex e (Summary) @findex gnus-summary-edit-article @kindex C-c C-c (Article) --- 5171,5204 ---- process/prefix convention (@pxref{Process/Prefix}). @table @kbd ! @item B e ! @kindex B e (Summary) @findex gnus-summary-expire-articles Expire all expirable articles in the group (@code{gnus-summary-expire-articles}). ! @item B DEL ! @kindex B DEL (Summary) @findex gnus-summary-delete-articles Delete the mail article. This is "delete" as in "delete it from your disk forever and ever, never to return again." Use with caution. (@code{gnus-summary-delete-article}). ! @item B m ! @kindex B m (Summary) @findex gnus-summary-move-article Move the article from one mail group to another (@code{gnus-summary-move-article}). ! @item B c ! @kindex B c (Summary) @findex gnus-summary-copy-article Copy the article from one group (mail group or not) to a mail group (@code{gnus-summary-copy-article}). ! @item B r ! @kindex B r (Summary) @findex gnus-summary-respool-article Respool the mail article (@code{gnus-summary-move-article}). ! @item B w @itemx e ! @kindex B w (Summary) @kindex e (Summary) @findex gnus-summary-edit-article @kindex C-c C-c (Article) *************** *** 5212,5238 **** @subsection Group Information @table @kbd ! @item V f ! @kindex V f (Summary) @findex gnus-summary-fetch-faq @vindex gnus-group-faq-directory Try to fetch the FAQ (list of frequently asked questions) for the current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the FAQ from @code{gnus-group-faq-directory}, which is usually a directory on a remote machine. @code{ange-ftp} will be used for fetching the file. ! @item V d ! @kindex V d (Summary) @findex gnus-summary-describe-group Give a brief description of the current group (@code{gnus-summary-describe-group}). If given a prefix, force rereading the description from the server. ! @item V ? ! @kindex V ? (Summary) @findex gnus-summary-describe-briefly Give a very brief description of the most important summary keystrokes (@code{gnus-summary-describe-briefly}). ! @item V i ! @kindex V i (Summary) @findex gnus-info-find-node Go to the Gnus info node (@code{gnus-info-find-node}). @end table --- 5226,5252 ---- @subsection Group Information @table @kbd ! @item H f ! @kindex H f (Summary) @findex gnus-summary-fetch-faq @vindex gnus-group-faq-directory Try to fetch the FAQ (list of frequently asked questions) for the current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the FAQ from @code{gnus-group-faq-directory}, which is usually a directory on a remote machine. @code{ange-ftp} will be used for fetching the file. ! @item H d ! @kindex H d (Summary) @findex gnus-summary-describe-group Give a brief description of the current group (@code{gnus-summary-describe-group}). If given a prefix, force rereading the description from the server. ! @item H h ! @kindex H h (Summary) @findex gnus-summary-describe-briefly Give a very brief description of the most important summary keystrokes (@code{gnus-summary-describe-briefly}). ! @item H i ! @kindex H i (Summary) @findex gnus-info-find-node Go to the Gnus info node (@code{gnus-info-find-node}). @end table *************** *** 5282,5301 **** @kindex V e (Summary) @findex gnus-summary-expand-window Expand the summary buffer window (@code{gnus-summary-expand-window}). - @item V S - @kindex V S (Summary) - @findex gnus-summary-reselect-current-group - Exit this group, and then enter it again - (@code{gnus-summary-reselect-current-group}). If given a prefix, select - all articles, both read and unread. - @item V g - @itemx M-g - @kindex V g (Summary) - @kindex M-g (Summary) - @findex gnus-summary-rescan-group - Exit the group, check for new articles in the group, and select the - group (@code{gnus-summary-rescan-group}). If given a prefix, select all - articles, both read and unread. @end table @node The Article Buffer --- 5296,5301 ----