Skip to content

GitLab

Commit c4c7f54c authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen
Browse files

Synched with Gnus 5.2.31.

parent b1cfbae4
Hide whitespace changes
Inline Side-by-side
Showing with 411 additions and 328 deletions
lisp/gnus-cache.el
View file @ c4c7f54c
......@@ -66,7 +66,10 @@ variable to \"^nnml\".")
(defun gnus-cache-open ()
"Initialize the cache."
(gnus-cache-read-active))
(when (or (file-exists-p gnus-cache-directory)
(and gnus-use-cache
(not (eq gnus-use-cache 'passive))))
(gnus-cache-read-active)))
(gnus-add-shutdown 'gnus-cache-close 'gnus)
......
lisp/gnus-msg.el
View file @ c4c7f54c
......@@ -55,20 +55,6 @@ message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
of names).")
(defvar gnus-message-archive-group
'((if (message-news-p) "misc-news" "misc-mail"))
"*Name of the group in which to save the messages you've written.
This can either be a string, a list of strings; or an alist
of regexps/functions/forms to be evaluated to return a string (or a list
of strings). The functions are called with the name of the current
group (or nil) as a parameter.
Normally the group names returned by this variable should be
unprefixed -- which implictly means \"store on the archive server\".
However, you may wish to store the message on some other server. In
that case, just return a fully prefixed name of the group --
\"nnml+private:mail.misc\", for instance.")
(defvar gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
......@@ -668,10 +654,9 @@ If YANK is non-nil, include the original article."
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
(switch-to-buffer gnus-summary-buffer)
(message-reply address)
(when yank
(gnus-inews-yank-articles yank)))))
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
......
lisp/gnus-nocem.el
View file @ c4c7f54c
......@@ -139,6 +139,7 @@ isn't bound, the message will be used unconditionally.")
(nnmail-time-since (nnmail-date-to-time date))
(nnmail-days-to-time gnus-nocem-expiry-wait)))
(gnus-request-article-this-buffer (mail-header-number header) group)
(goto-char (point-min))
;; The article has to have proper NoCeM headers.
(when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
(setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
......
lisp/gnus-score.el
View file @ c4c7f54c
......@@ -551,7 +551,7 @@ If optional argument `SILENT' is nil, show effect of score entry."
((eq type 'f)
(setq match (gnus-simplify-subject-fuzzy match))))
(let ((score (gnus-score-default score))
(header (downcase header))
(header (format "%s" (downcase header)))
new)
(and prompt (setq match (read-string
(format "Match %s on %s, %s: "
......@@ -566,6 +566,9 @@ If optional argument `SILENT' is nil, show effect of score entry."
(int-to-string match)
match))))
;; Get rid of string props.
(setq match (format "%s" match))
;; If this is an integer comparison, we transform from string to int.
(and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
(setq match (string-to-int match)))
......@@ -720,11 +723,11 @@ SCORE is the score to add."
(setq score (gnus-score-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(set-buffer gnus-summary-buffer)
(save-restriction
(goto-char (point-min))
(let ((id (mail-fetch-field "message-id")))
(when id
(set-buffer gnus-summary-buffer)
(gnus-summary-score-entry
"references" (concat id "[ \t]*$") 'r
score (current-time-string) nil t)))))))
......@@ -735,11 +738,11 @@ SCORE is the score to add."
(setq score (gnus-score-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(set-buffer gnus-summary-buffer)
(save-restriction
(goto-char (point-min))
(let ((id (mail-fetch-field "message-id")))
(when id
(set-buffer gnus-summary-buffer)
(gnus-summary-score-entry
"references" id 's
score (current-time-string))))))))
......
lisp/message.el
View file @ c4c7f54c
......@@ -40,7 +40,6 @@
(require 'mail-abbrevs)
(require 'mailabbrev))
;;;###autoload
(defvar message-directory "~/Mail/"
"*Directory from which all other mail file variables are derived.")
......@@ -164,9 +163,8 @@ If t, use `message-user-organization-file'.")
(defvar message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
;;;###autoload
(defvar message-autosave-directory
(concat (file-name-as-directory message-directory) "drafts/")
(defvar message-autosave-directory "~/"
; (concat (file-name-as-directory message-directory) "drafts/")
"*Directory where message autosaves buffers.
If nil, message won't autosave.")
......@@ -1095,6 +1093,8 @@ Puts point before the text and mark after.
Normally indents each nonblank line ARG spaces (default 3). However,
if `message-yank-prefix' is non-nil, insert that prefix on each line.
This function uses `message-cite-function' to do the actual citing.
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
......@@ -1531,8 +1531,9 @@ the user from the mailer."
;; Check "Shoot me".
(or (message-check-element 'shoot)
(save-excursion
(if (search-forward
".i-have-a-misconfigured-system-so-shoot-me" nil t)
(if (re-search-forward
"Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
nil t)
(y-or-n-p
"You appear to have a misconfigured system. Really post? ")
t)))
......@@ -2489,7 +2490,9 @@ Headers already prepared in the buffer are not modified."
follow-to)))))
(widen))
(message-pop-to-buffer (message-buffer-name "reply" from))
(message-pop-to-buffer (message-buffer-name
(if wide "wide reply" "reply") from
(if wide to-address nil)))
(setq message-reply-headers
(vector 0 subject from date message-id references 0 0 ""))
......
lisp/nnbabyl.el
View file @ c4c7f54c
;;; nnbabyl.el --- rmail mbox access for Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
......@@ -18,8 +18,9 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
......@@ -31,17 +32,21 @@
(require 'nnheader)
(require 'rmail)
(require 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))
(defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL")
(nnoo-declare nnbabyl)
(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
"The name of the rmail box file in the users home directory.")
(defvar nnbabyl-active-file (expand-file-name "~/.rmail-active")
(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
"The name of the active file for the rmail box.")
(defvar nnbabyl-get-new-mail t
(defvoo nnbabyl-get-new-mail t
"If non-nil, nnbabyl will check the incoming mail file and split the mail.")
(defvar nnbabyl-prepare-save-mail-hook nil
(defvoo nnbabyl-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
......@@ -51,223 +56,219 @@
(defconst nnbabyl-version "nnbabyl 1.0"
"nnbabyl version.")
(defvar nnbabyl-mbox-buffer nil)
(defvar nnbabyl-current-group nil)
(defvar nnbabyl-status-string "")
(defvar nnbabyl-group-alist nil)
(defvar nnbabyl-active-timestamp nil)
(defvoo nnbabyl-mbox-buffer nil)
(defvoo nnbabyl-current-group nil)
(defvoo nnbabyl-status-string "")
(defvoo nnbabyl-group-alist nil)
(defvoo nnbabyl-active-timestamp nil)
(defvoo nnbabyl-previous-buffer-mode nil)
(defvar nnbabyl-current-server nil)
(defvar nnbabyl-server-alist nil)
(defvar nnbabyl-server-variables
(list
(list 'nnbabyl-mbox-file nnbabyl-mbox-file)
(list 'nnbabyl-active-file nnbabyl-active-file)
(list 'nnbabyl-get-new-mail nnbabyl-get-new-mail)
'(nnbabyl-current-group nil)
'(nnbabyl-status-string "")
'(nnbabyl-group-alist nil)))
(eval-and-compile
(autoload 'gnus-set-text-properties "gnus-ems"))
;;; Interface functions
(defun nnbabyl-retrieve-headers (sequence &optional newsgroup server)
(nnoo-define-basics nnbabyl)
(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((number (length sequence))
(let ((number (length articles))
(count 0)
(delim (concat "^" nnbabyl-mail-delimiter))
article art-string start stop)
(nnbabyl-possibly-change-newsgroup newsgroup)
(if (stringp (car sequence))
'headers
(while sequence
(setq article (car sequence))
(setq art-string (nnbabyl-article-string article))
(set-buffer nnbabyl-mbox-buffer)
(if (or (search-forward art-string nil t)
(nnbabyl-possibly-change-newsgroup group server)
(while (setq article (pop articles))
(setq art-string (nnbabyl-article-string article))
(set-buffer nnbabyl-mbox-buffer)
(beginning-of-line)
(when (or (search-forward art-string nil t)
(search-backward art-string nil t))
(progn
(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
(while (and (not (looking-at ".+:"))
(zerop (forward-line 1))))
(setq start (point))
(search-forward "\n\n" nil t)
(setq stop (1- (point)))
(set-buffer nntp-server-buffer)
(insert "221 " (int-to-string article) " Article retrieved.\n")
(insert-buffer-substring nnbabyl-mbox-buffer start stop)
(goto-char (point-max))
(insert ".\n")))
(setq sequence (cdr sequence))
(setq count (1+ count))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(zerop (% count 20))
gnus-verbose-backends
(message "nnbabyl: Receiving headers... %d%%"
(/ (* count 100) number))))
(re-search-backward delim nil t)
(while (and (not (looking-at ".+:"))
(zerop (forward-line 1))))
(setq start (point))
(search-forward "\n\n" nil t)
(setq stop (1- (point)))
(set-buffer nntp-server-buffer)
(insert "221 ")
(princ article (current-buffer))
(insert " Article retrieved.\n")
(insert-buffer-substring nnbabyl-mbox-buffer start stop)
(goto-char (point-max))
(insert ".\n"))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
gnus-verbose-backends
(message "nnbabyl: Receiving headers...done"))
;; Fold continuation lines.
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
'headers))))
(defun nnbabyl-open-server (server &optional defs)
(nnheader-init-server-buffer)
(if (equal server nnbabyl-current-server)
t
(if nnbabyl-current-server
(setq nnbabyl-server-alist
(cons (list nnbabyl-current-server
(nnheader-save-variables nnbabyl-server-variables))
nnbabyl-server-alist)))
(let ((state (assoc server nnbabyl-server-alist)))
(if state
(progn
(nnheader-restore-variables (nth 1 state))
(setq nnbabyl-server-alist (delq state nnbabyl-server-alist)))
(nnheader-set-init-variables nnbabyl-server-variables defs)))
(setq nnbabyl-current-server server)))
(defun nnbabyl-close-server (&optional server)
(zerop (% (incf count) 20))
(nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
(/ (* count 100) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(nnheader-message 5 "nnbabyl: Receiving headers...done"))
(set-buffer nntp-server-buffer)
(nnheader-fold-continuation-lines)
'headers)))
(deffoo nnbabyl-open-server (server &optional defs)
(nnoo-change-server 'nnbabyl server defs)
(cond
((not (file-exists-p nnbabyl-mbox-file))
(nnbabyl-close-server)
(nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
((file-directory-p nnbabyl-mbox-file)
(nnbabyl-close-server)
(nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
(t
(nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
nnbabyl-mbox-file)
t)))
(deffoo nnbabyl-close-server (&optional server)
;; Restore buffer mode.
(when (and (nnbabyl-server-opened)
nnbabyl-previous-buffer-mode)
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(narrow-to-region
(caar nnbabyl-previous-buffer-mode)
(cdar nnbabyl-previous-buffer-mode))
(funcall (cdr nnbabyl-previous-buffer-mode))))
(nnoo-close-server 'nnbabyl server)
(setq nnbabyl-mbox-buffer nil)
t)
(defun nnbabyl-server-opened (&optional server)
(and (equal server nnbabyl-current-server)
(deffoo nnbabyl-server-opened (&optional server)
(and (nnoo-current-server-p 'nnbabyl server)
nnbabyl-mbox-buffer
(buffer-name nnbabyl-mbox-buffer)
nntp-server-buffer
(buffer-name nntp-server-buffer)))
(defun nnbabyl-status-message (&optional server)
nnbabyl-status-string)
(defun nnbabyl-request-article (article &optional newsgroup server buffer)
(nnbabyl-possibly-change-newsgroup newsgroup)
(if (stringp article)
nil
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(goto-char (point-min))
(if (search-forward (nnbabyl-article-string article) nil t)
(let (start stop summary-line)
(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
(while (and (not (looking-at ".+:"))
(zerop (forward-line 1))))
(setq start (point))
(or (and (re-search-forward
(concat "^" nnbabyl-mail-delimiter) nil t)
(forward-line -1))
(goto-char (point-max)))
(setq stop (point))
(let ((nntp-server-buffer (or buffer nntp-server-buffer)))
(set-buffer nntp-server-buffer)
(erase-buffer)
(insert-buffer-substring nnbabyl-mbox-buffer start stop)
(goto-char (point-min))
;; If there is an EOOH header, then we have to remove some
;; duplicated headers.
(setq summary-line (looking-at "Summary-line:"))
(if (search-forward "\n*** EOOH ***" nil t)
(if summary-line
;; The headers to be deleted are located before the
;; EOOH line...
(delete-region (point-min)
(progn (forward-line 1) (point)))
;; ...or after.
(delete-region (progn (beginning-of-line) (point))
(or (search-forward "\n\n" nil t)
(point)))))
t))))))
(defun nnbabyl-request-group (group &optional server dont-check)
(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
(nnbabyl-possibly-change-newsgroup newsgroup server)
(save-excursion
(if (nnbabyl-possibly-change-newsgroup group)
(if dont-check
t
(nnbabyl-get-new-mail group)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((active (assoc group nnbabyl-group-alist)))
(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)))))
(defun nnbabyl-close-group (group &optional server)
(set-buffer nnbabyl-mbox-buffer)
(goto-char (point-min))
(when (search-forward (nnbabyl-article-string article) nil t)
(let (start stop summary-line)
(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
(while (and (not (looking-at ".+:"))
(zerop (forward-line 1))))
(setq start (point))
(or (and (re-search-forward
(concat "^" nnbabyl-mail-delimiter) nil t)
(forward-line -1))
(goto-char (point-max)))
(setq stop (point))
(let ((nntp-server-buffer (or buffer nntp-server-buffer)))
(set-buffer nntp-server-buffer)
(erase-buffer)
(insert-buffer-substring nnbabyl-mbox-buffer start stop)
(goto-char (point-min))
;; If there is an EOOH header, then we have to remove some
;; duplicated headers.
(setq summary-line (looking-at "Summary-line:"))
(when (search-forward "\n*** EOOH ***" nil t)
(if summary-line
;; The headers to be deleted are located before the
;; EOOH line...
(delete-region (point-min) (progn (forward-line 1)
(point)))
;; ...or after.
(delete-region (progn (beginning-of-line) (point))
(or (search-forward "\n\n" nil t)
(point)))))
(if (numberp article)
(cons nnbabyl-current-group article)
(nnbabyl-article-group-number)))))))
(deffoo nnbabyl-request-group (group &optional server dont-check)
(let ((active (cadr (assoc group nnbabyl-group-alist))))
(save-excursion
(cond
((or (null active)
(null (nnbabyl-possibly-change-newsgroup group server)))
(nnheader-report 'nnbabyl "No such group: %s" group))
(dont-check
(nnheader-report 'nnbabyl "Selected group %s" group)
(nnheader-insert ""))
(t
(nnheader-report 'nnbabyl "Selected group %s" group)
(nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr active) (car active)))
(car active) (cdr active) group))))))
(deffoo nnbabyl-request-scan (&optional group server)
(nnbabyl-read-mbox)
(nnmail-get-new-mail
'nnbabyl
(lambda ()
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(save-buffer)))
nnbabyl-mbox-file group
(lambda ()
(save-excursion
(let ((in-buf (current-buffer)))
(goto-char (point-min))
(while (search-forward "\n\^_\n" nil t)
(delete-char -1))
(set-buffer nnbabyl-mbox-buffer)
(goto-char (point-max))
(search-backward "\n\^_" nil t)
(goto-char (match-end 0))
(insert-buffer-substring in-buf)))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
(deffoo nnbabyl-close-group (group &optional server)
t)
(defun nnbabyl-request-create-group (group &optional server)
(deffoo nnbabyl-request-create-group (group &optional server)
(nnmail-activate 'nnbabyl)
(or (assoc group nnbabyl-group-alist)
(let (active)
(setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0)))
nnbabyl-group-alist))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
(unless (assoc group nnbabyl-group-alist)
(setq nnbabyl-group-alist (cons (list group (cons 1 0))
nnbabyl-group-alist))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
t)
(defun nnbabyl-request-list (&optional server)
(if server (nnbabyl-get-new-mail))
(deffoo nnbabyl-request-list (&optional server)
(save-excursion
(or (nnmail-find-file nnbabyl-active-file)
(progn
(setq nnbabyl-group-alist (nnmail-get-active))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
(nnmail-find-file nnbabyl-active-file)))))
(nnmail-find-file nnbabyl-active-file)
(setq nnbabyl-group-alist (nnmail-get-active))))
(defun nnbabyl-request-newgroups (date &optional server)
(deffoo nnbabyl-request-newgroups (date &optional server)
(nnbabyl-request-list server))
(defun nnbabyl-request-list-newsgroups (&optional server)
(setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.")
nil)
(defun nnbabyl-request-post (&optional server)
(mail-send-and-exit nil))
(defalias 'nnbabyl-request-post-buffer 'nnmail-request-post-buffer)
(deffoo nnbabyl-request-list-newsgroups (&optional server)
(nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
(defun nnbabyl-request-expire-articles
(deffoo nnbabyl-request-expire-articles
(articles newsgroup &optional server force)
(nnbabyl-possibly-change-newsgroup newsgroup)
(let* ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function newsgroup))
nnmail-expiry-wait))
(is-old t)
(nnbabyl-possibly-change-newsgroup newsgroup server)
(let* ((is-old t)
rest)
(nnmail-activate 'nnbabyl)
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(set-text-properties (point-min) (point-max) nil)
(gnus-set-text-properties (point-min) (point-max) nil)
(while (and articles is-old)
(goto-char (point-min))
(if (search-forward (nnbabyl-article-string (car articles)) nil t)
(if (or force
(setq is-old
(> (nnmail-days-between
(current-time-string)
(buffer-substring
(point) (progn (end-of-line) (point))))
days)))
(if (setq is-old
(nnmail-expired-article-p
newsgroup
(buffer-substring
(point) (progn (end-of-line) (point))) force))
(progn
(and gnus-verbose-backends
(message "Deleting article %s..." (car articles)))
(nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnbabyl-delete-mail))
(setq rest (cons (car articles) rest))))
(setq articles (cdr articles)))
......@@ -283,9 +284,9 @@
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
(nconc rest articles))))
(defun nnbabyl-request-move-article
(deffoo nnbabyl-request-move-article
(article group server accept-form &optional last)
(nnbabyl-possibly-change-newsgroup group)
(nnbabyl-possibly-change-newsgroup group server)
(let ((buf (get-buffer-create " *nnbabyl move*"))
result)
(and
......@@ -310,7 +311,9 @@
(and last (save-buffer))))
result))
(defun nnbabyl-request-accept-article (group &optional last)
(deffoo nnbabyl-request-accept-article (group &optional server last)
(nnbabyl-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
result beg)
(and
......@@ -330,14 +333,13 @@
(goto-char (point-max))
(search-backward "\n\^_")
(goto-char (match-end 0))
(insert-buffer buf)
(and last (progn
(save-buffer)
(nnmail-save-active
nnbabyl-group-alist nnbabyl-active-file)))
(insert-buffer-substring buf)
(when last
(save-buffer)