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
a8151ef7
Commit
a8151ef7
authored
Sep 24, 1997
by
Lars Magne Ingebrigtsen
Browse files
*** empty log message ***
parent
5f016f40
Changes
38
Hide whitespace changes
Inline
Side-by-side
Showing
20 changed files
with
647 additions
and
441 deletions
+647
-441
lisp/gnus/gnus-art.el
lisp/gnus/gnus-art.el
+138
-100
lisp/gnus/gnus-cache.el
lisp/gnus/gnus-cache.el
+33
-28
lisp/gnus/gnus-cite.el
lisp/gnus/gnus-cite.el
+5
-3
lisp/gnus/gnus-demon.el
lisp/gnus/gnus-demon.el
+36
-20
lisp/gnus/gnus-ems.el
lisp/gnus/gnus-ems.el
+20
-8
lisp/gnus/gnus-gl.el
lisp/gnus/gnus-gl.el
+2
-5
lisp/gnus/gnus-group.el
lisp/gnus/gnus-group.el
+66
-48
lisp/gnus/gnus-int.el
lisp/gnus/gnus-int.el
+1
-1
lisp/gnus/gnus-move.el
lisp/gnus/gnus-move.el
+9
-5
lisp/gnus/gnus-msg.el
lisp/gnus/gnus-msg.el
+6
-1
lisp/gnus/gnus-nocem.el
lisp/gnus/gnus-nocem.el
+34
-10
lisp/gnus/gnus-range.el
lisp/gnus/gnus-range.el
+3
-3
lisp/gnus/gnus-salt.el
lisp/gnus/gnus-salt.el
+71
-45
lisp/gnus/gnus-score.el
lisp/gnus/gnus-score.el
+51
-48
lisp/gnus/gnus-soup.el
lisp/gnus/gnus-soup.el
+2
-2
lisp/gnus/gnus-srvr.el
lisp/gnus/gnus-srvr.el
+9
-3
lisp/gnus/gnus-start.el
lisp/gnus/gnus-start.el
+46
-33
lisp/gnus/gnus-sum.el
lisp/gnus/gnus-sum.el
+67
-40
lisp/gnus/gnus-topic.el
lisp/gnus/gnus-topic.el
+36
-25
lisp/gnus/gnus-undo.el
lisp/gnus/gnus-undo.el
+12
-13
No files found.
lisp/gnus/gnus-art.el
View file @
a8151ef7
...
...
@@ -191,7 +191,7 @@ asynchronously. The compressed face will be piped to this command."
(
lambda
(
spec
)
(
list
(
format
format
(
car
spec
)
(
cadr
spec
))
2
3
(
intern
(
format
"gnus-emphasis-%s"
(
ca
r
(
c
ddr
spec
)))))
)
2
3
(
intern
(
format
"gnus-emphasis-%s"
(
caddr
spec
)))))
types
)))
"Alist that says how to fontify certain phrases.
Each item looks like this:
...
...
@@ -397,6 +397,11 @@ If you want to run a special decoding program like nkf, use this hook."
:type
'hook
:group
'gnus-article-various
)
(
defcustom
gnus-article-hide-pgp-hook
nil
"*A hook called after successfully hiding a PGP signature."
:type
'hook
:group
'gnus-article-various
)
(
defcustom
gnus-article-button-face
'bold
"Face used for highlighting buttons in the article buffer.
...
...
@@ -413,12 +418,20 @@ above them."
:type
'face
:group
'gnus-article-buttons
)
(
defcustom
gnus-signature-face
'italic
"Face used for highlighting a signature in the article buffer."
(
defcustom
gnus-signature-face
'gnus-signature-face
"Face used for highlighting a signature in the article buffer.
Obsolete; use the face `gnus-signature-face' for customizations instead."
:type
'face
:group
'gnus-article-highlight
:group
'gnus-article-signature
)
(
defface
gnus-signature-face
'
((((
type
x
))
(
:italic
t
)))
"Face used for highlighting a signature in the article buffer."
:group
'gnus-article-highlight
:group
'gnus-article-signature
)
(
defface
gnus-header-from-face
'
((((
class
color
)
(
background
dark
))
...
...
@@ -569,20 +582,20 @@ Initialized from `text-mode-syntax-table.")
(
defun
gnus-article-delete-text-of-type
(
type
)
"Delete text of TYPE in the current buffer."
(
save-excursion
(
let
((
e
(
point-min
))
b
)
(
while
(
setq
b
(
text-property-any
e
(
point-max
)
'article-type
type
))
(
setq
e
(
text-property-not-all
b
(
point-max
)
'article-type
type
)
)
(
delete-region
b
e
)))))
(
let
((
b
(
point-min
))
)
(
while
(
setq
b
(
text-property-any
b
(
point-max
)
'article-type
type
)
)
(
delete-region
b
(
or
(
text-property-not-all
b
(
point-max
)
'article-type
type
)
(
point-max
))
)))))
(
defun
gnus-article-delete-invisible-text
()
"Delete all invisible text in the current buffer."
(
save-excursion
(
let
((
e
(
point-min
))
b
)
(
while
(
setq
b
(
text-property-any
e
(
point-max
)
'invisible
t
))
(
setq
e
(
text-property-not-all
b
(
point-max
)
'invisible
t
)
)
(
delete-region
b
e
)))))
(
let
((
b
(
point-min
))
)
(
while
(
setq
b
(
text-property-any
b
(
point-max
)
'invisible
t
)
)
(
delete-region
b
(
or
(
text-property-not-all
b
(
point-max
)
'invisible
t
)
(
point-max
))
)))))
(
defun
gnus-article-text-type-exists-p
(
type
)
"Say whether any text of type TYPE exists in the buffer."
...
...
@@ -828,33 +841,46 @@ always hide."
(
nnheader-narrow-to-headers
)
(
setq
from
(
message-fetch-field
"from"
))
(
goto-char
(
point-min
))
(
whe
n
(
and
gnus-article-x-face-command
(
or
force
;; Check whether this face is censored.
(
not
gnus-article-x-face-too-ugly
)
(
and
gnus-article-x-face-too-ugly
from
(
not
(
string-match
gnus-article-x-face-too-ugly
from
))))
;; Has to be present.
(
re-search-forward
"^X-Face: "
nil
t
))
(
wh
il
e
(
and
gnus-article-x-face-command
(
or
force
;; Check whether this face is censored.
(
not
gnus-article-x-face-too-ugly
)
(
and
gnus-article-x-face-too-ugly
from
(
not
(
string-match
gnus-article-x-face-too-ugly
from
))))
;; Has to be present.
(
re-search-forward
"^X-Face: "
nil
t
))
;; We now have the area of the buffer where the X-Face is stored.
(
let
((
beg
(
point
))
(
end
(
1-
(
re-search-forward
"^\\($\\|[^ \t]\\)"
nil
t
))))
;; We display the face.
(
if
(
symbolp
gnus-article-x-face-command
)
;; The command is a lisp function, so we call it.
(
if
(
gnus-functionp
gnus-article-x-face-command
)
(
funcall
gnus-article-x-face-command
beg
end
)
(
error
"%s is not a function"
gnus-article-x-face-command
))
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(
let
((
process-connection-type
nil
))
(
process-kill-without-query
(
start-process
"article-x-face"
nil
shell-file-name
shell-command-switch
gnus-article-x-face-command
))
(
process-send-region
"article-x-face"
beg
end
)
(
process-send-eof
"article-x-face"
)))))))))
(
save-excursion
(
let
((
beg
(
point
))
(
end
(
1-
(
re-search-forward
"^\\($\\|[^ \t]\\)"
nil
t
))))
;; We display the face.
(
if
(
symbolp
gnus-article-x-face-command
)
;; The command is a lisp function, so we call it.
(
if
(
gnus-functionp
gnus-article-x-face-command
)
(
funcall
gnus-article-x-face-command
beg
end
)
(
error
"%s is not a function"
gnus-article-x-face-command
))
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(
let
((
process-connection-type
nil
))
(
process-kill-without-query
(
start-process
"article-x-face"
nil
shell-file-name
shell-command-switch
gnus-article-x-face-command
))
(
process-send-region
"article-x-face"
beg
end
)
(
process-send-eof
"article-x-face"
))))))))))
(
defun
gnus-hack-decode-rfc1522
()
"Emergency hack function for avoiding problems when decoding."
(
let
((
buffer-read-only
nil
))
(
goto-char
(
point-min
))
;; Remove encoded TABs.
(
while
(
search-forward
"=09"
nil
t
)
(
replace-match
" "
t
t
))
;; Remove encoded newlines.
(
goto-char
(
point-min
))
(
while
(
search-forward
"=10"
nil
t
)
(
replace-match
" "
t
t
))))
(
defalias
'gnus-decode-rfc1522
'article-decode-rfc1522
)
(
defalias
'gnus-article-decode-rfc1522
'article-decode-rfc1522
)
...
...
@@ -937,27 +963,28 @@ always hide."
;; Hide the "header".
(
when
(
search-forward
"\n-----BEGIN PGP SIGNED MESSAGE-----\n"
nil
t
)
(
gnus-article-hide-text-type
(
1+
(
match-beginning
0
))
(
match-end
0
)
'pgp
))
(
setq
beg
(
point
))
;; Hide the actual signature.
(
and
(
search-forward
"\n-----BEGIN PGP SIGNATURE-----\n"
nil
t
)
(
setq
end
(
1+
(
match-beginning
0
)))
(
gnus-article-hide-text-type
end
(
if
(
search-forward
"\n-----END PGP SIGNATURE-----\n"
nil
t
)
(
match-end
0
)
;; Perhaps we shouldn't hide to the end of the buffer
;; if there is no end to the signature?
(
point-max
))
'pgp
))
;; Hide "- " PGP quotation markers.
(
when
(
and
beg
end
)
(
narrow-to-region
beg
end
)
(
goto-char
(
point-min
))
(
while
(
re-search-forward
"^- "
nil
t
)
(
gnus-article-hide-text-type
(
match-beginning
0
)
(
match-end
0
)
'pgp
))
(
widen
))))))
(
match-end
0
)
'pgp
)
(
setq
beg
(
point
))
;; Hide the actual signature.
(
and
(
search-forward
"\n-----BEGIN PGP SIGNATURE-----\n"
nil
t
)
(
setq
end
(
1+
(
match-beginning
0
)))
(
gnus-article-hide-text-type
end
(
if
(
search-forward
"\n-----END PGP SIGNATURE-----\n"
nil
t
)
(
match-end
0
)
;; Perhaps we shouldn't hide to the end of the buffer
;; if there is no end to the signature?
(
point-max
))
'pgp
))
;; Hide "- " PGP quotation markers.
(
when
(
and
beg
end
)
(
narrow-to-region
beg
end
)
(
goto-char
(
point-min
))
(
while
(
re-search-forward
"^- "
nil
t
)
(
gnus-article-hide-text-type
(
match-beginning
0
)
(
match-end
0
)
'pgp
))
(
widen
))
(
run-hooks
'gnus-article-hide-pgp-hook
))))))
(
defun
article-hide-pem
(
&optional
arg
)
"Toggle hiding of any PEM headers and signatures in the current article.
...
...
@@ -1101,7 +1128,8 @@ Put point at the beginning of the signature separator."
nil
)))
(
eval-and-compile
(
autoload
'w3-parse-buffer
"w3-parse"
))
(
autoload
'w3-display
"w3-parse"
)
(
autoload
'w3-do-setup
"w3"
""
t
))
(
defun
gnus-article-treat-html
()
"Render HTML."
...
...
@@ -1109,6 +1137,7 @@ Put point at the beginning of the signature separator."
(
let
((
cbuf
(
current-buffer
)))
(
set-buffer
gnus-article-buffer
)
(
let
(
buf
buffer-read-only
b
e
)
(
w3-do-setup
)
(
goto-char
(
point-min
))
(
narrow-to-region
(
if
(
search-forward
"\n\n"
nil
t
)
...
...
@@ -1117,12 +1146,13 @@ Put point at the beginning of the signature separator."
(
setq
e
(
point-max
)))
(
nnheader-temp-write
nil
(
insert-buffer-substring
gnus-article-buffer
b
e
)
(
require
'url
)
(
save-window-excursion
(
setq
buf
(
car
(
w3-parse-buffer
(
current-buffer
))))))
(
w3-region
(
point-min
)
(
point-max
))
(
setq
buf
(
buffer-substring-no-properties
(
point-min
)
(
point-max
)))))
(
when
buf
(
delete-region
(
point-min
)
(
point-max
))
(
insert-buffer-substring
buf
)
(
kill-buffer
buf
))
(
insert
buf
))
(
widen
)
(
goto-char
(
point-min
))
(
set-window-start
(
get-buffer-window
(
current-buffer
))
(
point-min
))
...
...
@@ -1391,7 +1421,7 @@ This format is defined by the `gnus-article-time-format' variable."
(
gnus-article-hide-headers
1
t
)))
(
save-window-excursion
(
if
(
not
gnus-default-article-saver
)
(
error
"No default saver is defined
.
"
)
(
error
"No default saver is defined"
)
;; !!! Magic! The saving functions all save
;; `gnus-original-article-buffer' (or so they think), but we
;; bind that variable to our save-buffer.
...
...
@@ -1452,7 +1482,8 @@ This format is defined by the `gnus-article-time-format' variable."
default-name
))
;; A single split name was found
((
=
1
(
length
split-name
))
(
let*
((
name
(
car
split-name
))
(
let*
((
name
(
expand-file-name
(
car
split-name
)
gnus-article-save-directory
))
(
dir
(
cond
((
file-directory-p
name
)
(
file-name-as-directory
name
))
((
file-exists-p
name
)
name
)
...
...
@@ -1718,34 +1749,33 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(
put
'gnus-article-mode
'mode-class
'special
)
(
when
t
(
gnus-define-keys
gnus-article-mode-map
" "
gnus-article-goto-next-page
"\177"
gnus-article-goto-prev-page
[delete]
gnus-article-goto-prev-page
"\C-c^"
gnus-article-refer-article
"h"
gnus-article-show-summary
"s"
gnus-article-show-summary
"\C-c\C-m"
gnus-article-mail
"?"
gnus-article-describe-briefly
gnus-mouse-2
gnus-article-push-button
"\r"
gnus-article-press-button
"\t"
gnus-article-next-button
"\M-\t"
gnus-article-prev-button
"e"
gnus-article-edit
"<"
beginning-of-buffer
">"
end-of-buffer
"\C-c\C-i"
gnus-info-find-node
"\C-c\C-b"
gnus-bug
"\C-d"
gnus-article-read-summary-keys
"\M-*"
gnus-article-read-summary-keys
"\M-#"
gnus-article-read-summary-keys
"\M-^"
gnus-article-read-summary-keys
"\M-g"
gnus-article-read-summary-keys
)
(
substitute-key-definition
'undefined
'gnus-article-read-summary-keys
gnus-article-mode-map
))
(
gnus-define-keys
gnus-article-mode-map
" "
gnus-article-goto-next-page
"\177"
gnus-article-goto-prev-page
[delete]
gnus-article-goto-prev-page
"\C-c^"
gnus-article-refer-article
"h"
gnus-article-show-summary
"s"
gnus-article-show-summary
"\C-c\C-m"
gnus-article-mail
"?"
gnus-article-describe-briefly
gnus-mouse-2
gnus-article-push-button
"\r"
gnus-article-press-button
"\t"
gnus-article-next-button
"\M-\t"
gnus-article-prev-button
"e"
gnus-article-edit
"<"
beginning-of-buffer
">"
end-of-buffer
"\C-c\C-i"
gnus-info-find-node
"\C-c\C-b"
gnus-bug
"\C-d"
gnus-article-read-summary-keys
"\M-*"
gnus-article-read-summary-keys
"\M-#"
gnus-article-read-summary-keys
"\M-^"
gnus-article-read-summary-keys
"\M-g"
gnus-article-read-summary-keys
)
(
substitute-key-definition
'undefined
'gnus-article-read-summary-keys
gnus-article-mode-map
)
(
defun
gnus-article-make-menu-bar
()
(
gnus-turn-off-edit-menu
'article
)
...
...
@@ -2032,7 +2062,8 @@ Provided for backwards compatibility."
;; save it to file.
(
goto-char
(
point-max
))
(
insert
"\n"
)
(
append-to-file
(
point-min
)
(
point-max
)
file-name
))))
(
append-to-file
(
point-min
)
(
point-max
)
file-name
)
t
)))
(
defun
gnus-narrow-to-page
(
&optional
arg
)
"Narrow the article buffer to a page.
...
...
@@ -2151,6 +2182,7 @@ Argument LINES specifies lines to be scrolled down."
(
interactive
)
(
if
(
not
(
gnus-buffer-live-p
gnus-summary-buffer
))
(
error
"There is no summary buffer for this article buffer"
)
(
gnus-article-set-globals
)
(
gnus-configure-windows
'article
)
(
gnus-summary-goto-subject
gnus-current-article
)))
...
...
@@ -2442,7 +2474,7 @@ groups."
(
interactive
"P"
)
(
when
(
and
(
not
force
)
(
gnus-group-read-only-p
))
(
error
"The current newsgroup does not support article editing
.
"
))
(
error
"The current newsgroup does not support article editing"
))
(
gnus-article-edit-article
`
(
lambda
()
(
gnus-summary-edit-article-done
...
...
@@ -2454,7 +2486,7 @@ groups."
(
let
((
winconf
(
current-window-configuration
)))
(
set-buffer
gnus-article-buffer
)
(
gnus-article-edit-mode
)
(
set-text-properties
(
point-min
)
(
point-max
)
nil
)
(
gnus-
set-text-properties
(
point-min
)
(
point-max
)
nil
)
(
gnus-configure-windows
'edit-article
)
(
setq
gnus-article-edit-done-function
exit-func
)
(
setq
gnus-prev-winconf
winconf
)
...
...
@@ -2532,14 +2564,14 @@ groups."
(
defcustom
gnus-button-alist
`
((
"<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>"
0
t
gnus-button-message-id
2
)
(
"\\bnews:\\([^>\n\t ]*@[^>\n\t ]*
+
\\)"
0
t
gnus-button-message-id
1
)
(
"\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)"
0
t
gnus-button-message-id
1
)
(
"\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)"
1
t
gnus-button-fetch-group
4
)
(
"\\bnews:\\(//\\)?\\([^>\n\t ]+\\)"
0
t
gnus-button-fetch-group
2
)
(
"\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
2
t
gnus-button-message-id
3
)
(
"\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
0
t
gnus-url-mailto
1
)
(
"\\bmailto:\\([^ \n\t]+\\)"
0
t
gnus-url-mailto
2
)
(
"\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
0
t
gnus-url-mailto
2
)
(
"\\bmailto:\\([^ \n\t]+\\)"
0
t
gnus-url-mailto
1
)
;; This is how URLs _should_ be embedded in text...
(
"<URL: *\\([^>]*\\)>"
0
t
gnus-button-embedded-url
1
)
;; Raw URLs.
...
...
@@ -2572,6 +2604,7 @@ variable it the real callback function."
(
"^\\(Cc\\|To\\):"
"[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0
t
gnus-button-mailto
0
)
(
"^X-[Uu][Rr][Ll]:"
,
gnus-button-url-regexp
0
t
gnus-button-url
0
)
(
"^Subject:"
,
gnus-button-url-regexp
0
t
gnus-button-url
0
)
(
"^[^:]+:"
,
gnus-button-url-regexp
0
t
gnus-button-url
0
)
(
"^[^:]+:"
"\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)"
1
t
gnus-button-message-id
3
))
...
...
@@ -2846,6 +2879,11 @@ specified by `gnus-button-alist'."
;;; Internal functions:
(
defun
gnus-article-set-globals
()
(
save-excursion
(
set-buffer
gnus-summary-buffer
)
(
gnus-set-global-variables
)))
(
defun
gnus-signature-toggle
(
end
)
(
save-excursion
(
set-buffer
gnus-article-buffer
)
...
...
lisp/gnus/gnus-cache.el
View file @
a8151ef7
...
...
@@ -146,7 +146,8 @@ variable to \"^nnml\"."
(
mail-header-set-number
headers
(
cdr
result
))))
(
let
((
number
(
mail-header-number
headers
))
file
dir
)
(
when
(
and
(
>
number
0
)
; Reffed article.
(
when
(
and
number
(
>
number
0
)
; Reffed article.
(
or
force
(
and
(
or
(
not
gnus-uncacheable-groups
)
(
not
(
string-match
...
...
@@ -256,15 +257,13 @@ variable to \"^nnml\"."
(
defun
gnus-cache-possibly-alter-active
(
group
active
)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(
when
(
equal
group
"no.norsk"
)
(
error
"hie"
))
(
when
gnus-cache-active-hashtb
(
let
((
cache-active
(
gnus-gethash
group
gnus-cache-active-hashtb
)))
(
and
cache-active
(
<
(
car
cache-active
)
(
car
active
))
(
setcar
active
(
car
cache-active
)))
(
and
cache-active
(
>
(
cdr
cache-active
)
(
cdr
active
))
(
setcdr
active
(
cdr
cache-active
))))))
(
when
cache-active
(
when
(
<
(
car
cache-active
)
(
car
active
))
(
setcar
active
(
car
cache-active
)))
(
when
(
>
(
cdr
cache-active
)
(
cdr
active
))
(
setcdr
active
(
cdr
cache-active
)))))))
(
defun
gnus-cache-retrieve-headers
(
articles
group
&optional
fetch-old
)
"Retrieve the headers for ARTICLES in GROUP."
...
...
@@ -453,13 +452,20 @@ Returns the list of articles removed."
(
defun
gnus-cache-articles-in-group
(
group
)
"Return a sorted list of cached articles in GROUP."
(
let
((
dir
(
file-name-directory
(
gnus-cache-file-name
group
1
))))
(
let
((
dir
(
file-name-directory
(
gnus-cache-file-name
group
1
)))
articles
)
(
when
(
file-exists-p
dir
)
(
sort
(
mapcar
(
lambda
(
name
)
(
string-to-int
name
))
(
directory-files
dir
nil
"^[0-9]+$"
t
))
'<
))))
(
defun
gnus-cache-braid-nov
(
group
cached
)
(
setq
articles
(
sort
(
mapcar
(
lambda
(
name
)
(
string-to-int
name
))
(
directory-files
dir
nil
"^[0-9]+$"
t
))
'<
))
;; Update the cache active file, just to synch more.
(
when
articles
(
gnus-cache-update-active
group
(
car
articles
)
t
)
(
gnus-cache-update-active
group
(
car
(
last
articles
))))
articles
)))
(
defun
gnus-cache-braid-nov
(
group
cached
&optional
file
)
(
let
((
cache-buf
(
get-buffer-create
" *gnus-cache*"
))
beg
end
)
(
gnus-cache-save-buffers
)
...
...
@@ -467,7 +473,7 @@ Returns the list of articles removed."
(
set-buffer
cache-buf
)
(
buffer-disable-undo
(
current-buffer
))
(
erase-buffer
)
(
insert-file-contents
(
gnus-cache-file-name
group
".overview"
))
(
insert-file-contents
(
or
file
(
gnus-cache-file-name
group
".overview"
))
)
(
goto-char
(
point-min
))
(
insert
"\n"
)
(
goto-char
(
point-min
)))
...
...
@@ -540,22 +546,21 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
(
gnus
)
;; Go through all groups...
(
gnus-group-mark-buffer
)
(
gnus-group-universal-argument
nil
nil
(
lambda
()
(
interactive
)
(
gnus-summary-read-group
(
gnus-group-group-name
)
nil
t
)
;; ... and enter the articles into the cache.
(
when
(
eq
major-mode
'gnus-summary-mode
)
(
gnus-uu-mark-buffer
)
(
gnus-cache-enter-article
)
(
kill-buffer
(
current-buffer
)))))))
(
gnus-group-iterate
nil
(
lambda
(
group
)
(
let
(
gnus-auto-select-next
)
(
gnus-summary-read-group
group
nil
t
)
;; ... and enter the articles into the cache.
(
when
(
eq
major-mode
'gnus-summary-mode
)
(
gnus-uu-mark-buffer
)
(
gnus-cache-enter-article
)
(
kill-buffer
(
current-buffer
))))))))
(
defun
gnus-cache-read-active
(
&optional
force
)
"Read the cache active file."
(
gnus-make-directory
gnus-cache-directory
)
(
if
(
not
(
and
(
file-exists-p
gnus-cache-active-file
)
(
or
force
(
not
gnus-cache-active-hashtb
)))
)
(
if
(
or
(
not
(
file-exists-p
gnus-cache-active-file
)
)
force
)
;; There is no active file, so we generate one.
(
gnus-cache-generate-active
)
;; We simply read the active file.
...
...
@@ -651,7 +656,7 @@ If LOW, update the lower bound instead."
(
defun
gnus-cache-move-cache
(
dir
)
"Move the cache tree to somewhere else."
(
interactive
"
D
Move the cache tree to: "
)
(
interactive
"
F
Move the cache tree to: "
)
(
rename-file
gnus-cache-directory
dir
))
(
provide
'gnus-cache
)
...
...
lisp/gnus/gnus-cite.el
View file @
a8151ef7
...
...
@@ -100,13 +100,14 @@ The first regexp group should match the Supercite attribution."
:group
'gnus-cite
:type
'integer
)
(
defcustom
gnus-cite-attribution-prefix
"in article\\|in <"
(
defcustom
gnus-cite-attribution-prefix
"in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),"
"Regexp matching the beginning of an attribution line."
:group
'gnus-cite
:type
'regexp
)
(
defcustom
gnus-cite-attribution-suffix
"\\(wrote\\|writes\\|said\\|says\\
):[ \t
]*$"
"\\(
\\(
wrote\\|writes\\|said\\|says\\
|>\\)\\(:\\|\\.\\.\\.\\)\\)[
]*$"
"Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group
'gnus-cite
...
...
@@ -439,7 +440,8 @@ If WIDTH (the numerical prefix), use that text width when filling."
(
setq
gnus-cite-prefix-alist
nil
gnus-cite-attribution-alist
nil
gnus-cite-loose-prefix-alist
nil
gnus-cite-loose-attribution-alist
nil
)))))
gnus-cite-loose-attribution-alist
nil
gnus-cite-article
nil
)))))
(
defun
gnus-article-hide-citation
(
&optional
arg
force
)
"Toggle hiding of all cited text except attribution lines.
...
...
lisp/gnus/gnus-demon.el
View file @
a8151ef7
...
...
@@ -152,21 +152,35 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
"Find out how many seconds to TIME, which is on the form \"17:43\"."
(
if
(
not
(
stringp
time
))
time
(
let*
((
date
(
current-time-string
))
(
dv
(
timezone-parse-date
date
))
(
tdate
(
timezone-make-arpa-date
(
string-to-number
(
aref
dv
0
))
(
string-to-number
(
aref
dv
1
))
(
string-to-number
(
aref
dv
2
))
time
(
or
(
aref
dv
4
)
"UT"
)))
(
nseconds
(
gnus-time-minus
(
gnus-encode-date
tdate
)
(
gnus-encode-date
date
))))
(
round
(
/
(
+
(
if
(
<
(
car
nseconds
)
0
)
86400
0
)
(
*
65536
(
car
nseconds
))
(
nth
1
nseconds
))
gnus-demon-timestep
)))))
(
let*
((
now
(
current-time
))
;; obtain NOW as discrete components -- make a vector for speed
(
nowParts
(
apply
'vector
(
decode-time
now
)))
;; obtain THEN as discrete components
(
thenParts
(
timezone-parse-time
time
))
(
thenHour
(
string-to-int
(
elt
thenParts
0
)))
(
thenMin
(
string-to-int
(
elt
thenParts
1
)))
;; convert time as elements into number of seconds since EPOCH.
(
then
(
encode-time
0
thenMin
thenHour
;; If THEN is earlier than NOW, make it
;; same time tomorrow. Doc for encode-time
;; says that this is OK.
(
+
(
elt
nowParts
3
)
(
if
(
or
(
<
thenHour
(
elt
nowParts
2
))
(
and
(
=
thenHour
(
elt
nowParts
2
))
(
<=
thenMin
(
elt
nowParts
1
))))
1
0
))
(
elt
nowParts
4
)
(
elt
nowParts
5
)
(
elt
nowParts
6
)
(
elt
nowParts
7
)
(
elt
nowParts
8
)))
;; calculate number of seconds between NOW and THEN
(
diff
(
+
(
*
65536
(
-
(
car
then
)
(
car
now
)))
(
-
(
cadr
then
)
(
cadr
now
)))))
;; return number of timesteps in the number of seconds
(
round
(
/
diff
gnus-demon-timestep
)))))
(
defun
gnus-demon
()
"The Gnus daemon that takes care of running all Gnus handlers."
...
...
@@ -202,7 +216,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
(
t
(
<
0
gnus-demon-idle-time
))))
; Or just need to be idle.
;; So we call the handler.
(
progn
(
funcall
(
car
handler
))
(
ignore-errors
(
funcall
(
car
handler
))
)
;; And reset the timer.
(
setcar
(
nthcdr
1
handler
)
(
gnus-demon-time-to-step
...
...
@@ -211,24 +225,26 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
((
null
(
setq
idle
(
nth
2
handler
)))
;; We do nothing.
)
((
not
(
numberp
idle
))
((
and
(
not
(
numberp
idle
))
(
gnus-demon-is-idle-p
))
;; We want to call this handler each and every time that
;; Emacs is idle.
(
funcall
(
car
handler
)))
(
ignore-errors
(
funcall
(
car
handler
)))
)
(
t
;; We want to call this handler only if Emacs has been idle
;; for a specified number of timesteps.
(
and
(
not
(
memq
(
car
handler
)
gnus-demon-idle-has-been-called
))
(
<
idle
gnus-demon-idle-time
)
(
gnus-demon-is-idle-p
)
(
progn
(
funcall
(
car
handler
))
(
ignore-errors
(
funcall
(
car
handler
))
)
;; Make sure the handler won't be called once more in
;; this idle-cycle.
(
push
(
car
handler
)
gnus-demon-idle-has-been-called
)))))))))
(
defun
gnus-demon-add-nocem
()
"Add daemonic NoCeM handling to Gnus."
(
gnus-demon-add-handler
'gnus-demon-scan-nocem
60
t
))
(
gnus-demon-add-handler
'gnus-demon-scan-nocem
60
30
))
(
defun
gnus-demon-scan-nocem
()
"Scan NoCeM groups for NoCeM messages."
...
...
lisp/gnus/gnus-ems.el
View file @
a8151ef7
...
...
@@ -34,11 +34,16 @@
(
defvar
gnus-mouse-2
[mouse-2]
)
(
defvar
gnus-down-mouse-2
[down-mouse-2]
)
(
defvar
gnus-mode-line-modified
(
if
(
or
gnus-xemacs
(
<
emacs-major-version
20
))