Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
c4c7f54c
Commit
c4c7f54c
authored
Jun 29, 1996
by
Lars Magne Ingebrigtsen
Browse files
Synched with Gnus 5.2.31.
parent
b1cfbae4
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
411 additions
and
328 deletions
+411
-328
lisp/gnus-cache.el
lisp/gnus-cache.el
+4
-1
lisp/gnus-msg.el
lisp/gnus-msg.el
+1
-16
lisp/gnus-nocem.el
lisp/gnus-nocem.el
+1
-0
lisp/gnus-score.el
lisp/gnus-score.el
+6
-3
lisp/message.el
lisp/message.el
+10
-7
lisp/nnbabyl.el
lisp/nnbabyl.el
+337
-290
lisp/nneething.el
lisp/nneething.el
+1
-1
lisp/nnfolder.el
lisp/nnfolder.el
+3
-2
lisp/nnheader.el
lisp/nnheader.el
+34
-0
lisp/nnmail.el
lisp/nnmail.el
+10
-6
lisp/nnmbox.el
lisp/nnmbox.el
+1
-1
lisp/nnmh.el
lisp/nnmh.el
+2
-0
lisp/nnspool.el
lisp/nnspool.el
+1
-1
No files found.
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."
)
(
defv
ar
nnbabyl-active-file
(
expand-file-name
"~/.rmail-active"
)
(
defv
oo
nnbabyl-active-file
(
expand-file-name
"~/.rmail-active"
)
"The name of the active file for the rmail box."
)
(
defv
ar
nnbabyl-get-new-mail
t
(
defv
oo
nnbabyl-get-new-mail
t
"If non-nil, nnbabyl will check the incoming mail file and split the mail."
)
(
defv
ar
nnbabyl-prepare-save-mail-hook
nil
(
defv
oo
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."
)
(
defv
ar
nnbabyl-mbox-buffer
nil
)
(
defv
ar
nnbabyl-current-group
nil
)
(
defv
ar
nnbabyl-status-string
""
)
(
defv
ar
nnbabyl-group-alist
nil
)
(
defv
ar
nnbabyl-active-timestamp
nil
)
(
defv
oo
nnbabyl-mbox-buffer
nil
)
(
defv
oo
nnbabyl-current-group
nil
)
(
defv
oo
nnbabyl-status-string
""
)
(
defv
oo
nnbabyl-group-alist
nil
)
(
defv
oo
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
)
(
def
un
nnbabyl-server-opened
(
&optional
server
)
(
and
(
equal
server
nnbabyl
-current-
server
)
(
def
foo
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
)
(
def
un
nnbabyl-request-create-group
(
group
&optional
server
)
(
def
foo
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
))))
(
def
un
nnbabyl-request-newgroups
(
date
&optional
server
)
(
def
foo
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."
))
(
def
un
nnbabyl-request-expire-articles
(
def
foo
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
))))
(
def
un
nnbabyl-request-move-article
(
def
foo
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
)