Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
6748645f
Commit
6748645f
authored
Feb 20, 1999
by
Lars Magne Ingebrigtsen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Upgrading to Gnus 5.7; see ChangeLog
parent
44a6ed57
Changes
59
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
59 changed files
with
6450 additions
and
4135 deletions
+6450
-4135
lisp/gnus/gnus-art.el
lisp/gnus/gnus-art.el
+441
-263
lisp/gnus/gnus-async.el
lisp/gnus/gnus-async.el
+21
-9
lisp/gnus/gnus-audio.el
lisp/gnus/gnus-audio.el
+6
-7
lisp/gnus/gnus-bcklg.el
lisp/gnus/gnus-bcklg.el
+7
-5
lisp/gnus/gnus-cache.el
lisp/gnus/gnus-cache.el
+53
-31
lisp/gnus/gnus-cite.el
lisp/gnus/gnus-cite.el
+99
-53
lisp/gnus/gnus-cus.el
lisp/gnus/gnus-cus.el
+14
-12
lisp/gnus/gnus-demon.el
lisp/gnus/gnus-demon.el
+34
-14
lisp/gnus/gnus-dup.el
lisp/gnus/gnus-dup.el
+5
-3
lisp/gnus/gnus-eform.el
lisp/gnus/gnus-eform.el
+6
-7
lisp/gnus/gnus-ems.el
lisp/gnus/gnus-ems.el
+73
-15
lisp/gnus/gnus-gl.el
lisp/gnus/gnus-gl.el
+11
-14
lisp/gnus/gnus-group.el
lisp/gnus/gnus-group.el
+145
-109
lisp/gnus/gnus-int.el
lisp/gnus/gnus-int.el
+233
-164
lisp/gnus/gnus-kill.el
lisp/gnus/gnus-kill.el
+16
-19
lisp/gnus/gnus-logic.el
lisp/gnus/gnus-logic.el
+7
-5
lisp/gnus/gnus-mh.el
lisp/gnus/gnus-mh.el
+3
-3
lisp/gnus/gnus-move.el
lisp/gnus/gnus-move.el
+20
-15
lisp/gnus/gnus-msg.el
lisp/gnus/gnus-msg.el
+211
-134
lisp/gnus/gnus-mule.el
lisp/gnus/gnus-mule.el
+10
-7
lisp/gnus/gnus-nocem.el
lisp/gnus/gnus-nocem.el
+42
-17
lisp/gnus/gnus-range.el
lisp/gnus/gnus-range.el
+5
-3
lisp/gnus/gnus-salt.el
lisp/gnus/gnus-salt.el
+108
-97
lisp/gnus/gnus-score.el
lisp/gnus/gnus-score.el
+362
-210
lisp/gnus/gnus-soup.el
lisp/gnus/gnus-soup.el
+30
-24
lisp/gnus/gnus-spec.el
lisp/gnus/gnus-spec.el
+30
-16
lisp/gnus/gnus-srvr.el
lisp/gnus/gnus-srvr.el
+98
-81
lisp/gnus/gnus-start.el
lisp/gnus/gnus-start.el
+155
-74
lisp/gnus/gnus-sum.el
lisp/gnus/gnus-sum.el
+1282
-1042
lisp/gnus/gnus-topic.el
lisp/gnus/gnus-topic.el
+150
-105
lisp/gnus/gnus-undo.el
lisp/gnus/gnus-undo.el
+29
-8
lisp/gnus/gnus-util.el
lisp/gnus/gnus-util.el
+217
-63
lisp/gnus/gnus-uu.el
lisp/gnus/gnus-uu.el
+212
-206
lisp/gnus/gnus-vm.el
lisp/gnus/gnus-vm.el
+5
-7
lisp/gnus/gnus-win.el
lisp/gnus/gnus-win.el
+48
-60
lisp/gnus/gnus.el
lisp/gnus/gnus.el
+329
-143
lisp/gnus/message.el
lisp/gnus/message.el
+509
-223
lisp/gnus/messcompat.el
lisp/gnus/messcompat.el
+11
-6
lisp/gnus/nnbabyl.el
lisp/gnus/nnbabyl.el
+7
-5
lisp/gnus/nndir.el
lisp/gnus/nndir.el
+5
-5
lisp/gnus/nndoc.el
lisp/gnus/nndoc.el
+175
-20
lisp/gnus/nndraft.el
lisp/gnus/nndraft.el
+105
-106
lisp/gnus/nneething.el
lisp/gnus/nneething.el
+13
-10
lisp/gnus/nnfolder.el
lisp/gnus/nnfolder.el
+159
-121
lisp/gnus/nngateway.el
lisp/gnus/nngateway.el
+11
-3
lisp/gnus/nnheader.el
lisp/gnus/nnheader.el
+64
-26
lisp/gnus/nnkiboze.el
lisp/gnus/nnkiboze.el
+32
-22
lisp/gnus/nnmail.el
lisp/gnus/nnmail.el
+223
-150
lisp/gnus/nnmbox.el
lisp/gnus/nnmbox.el
+10
-7
lisp/gnus/nnmh.el
lisp/gnus/nnmh.el
+54
-58
lisp/gnus/nnml.el
lisp/gnus/nnml.el
+56
-39
lisp/gnus/nnoo.el
lisp/gnus/nnoo.el
+42
-14
lisp/gnus/nnsoup.el
lisp/gnus/nnsoup.el
+21
-13
lisp/gnus/nnspool.el
lisp/gnus/nnspool.el
+8
-11
lisp/gnus/nntp.el
lisp/gnus/nntp.el
+282
-161
lisp/gnus/nnvirtual.el
lisp/gnus/nnvirtual.el
+47
-29
lisp/gnus/nnweb.el
lisp/gnus/nnweb.el
+56
-31
lisp/gnus/pop3.el
lisp/gnus/pop3.el
+33
-27
lisp/gnus/score-mode.el
lisp/gnus/score-mode.el
+10
-3
No files found.
lisp/gnus/gnus-art.el
View file @
6748645f
This diff is collapsed.
Click to expand it.
lisp/gnus/gnus-async.el
View file @
6748645f
;;; gnus-async.el --- asynchronous support for Gnus
;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Copyright (C) 1996,97
,98
Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@
ifi.uio.no
>
;; Author: Lars Magne Ingebrigtsen <larsi@
gnus.org
>
;; Keywords: news
;; This file is part of GNU Emacs.
...
...
@@ -27,6 +27,8 @@
(
eval-when-compile
(
require
'cl
))
(
eval-when-compile
(
require
'cl
))
(
require
'gnus
)
(
require
'gnus-sum
)
(
require
'nntp
)
...
...
@@ -77,6 +79,7 @@ It should return non-nil if the article is to be prefetched."
(
defvar
gnus-async-article-alist
nil
)
(
defvar
gnus-async-article-semaphore
'
(
nil
))
(
defvar
gnus-async-fetch-list
nil
)
(
defvar
gnus-asynch-obarray
nil
)
(
defvar
gnus-async-prefetch-headers-buffer
" *Async Prefetch Headers*"
)
(
defvar
gnus-async-header-prefetched
nil
)
...
...
@@ -120,7 +123,10 @@ It should return non-nil if the article is to be prefetched."
gnus-async-header-prefetched
nil
))
(
defun
gnus-async-set-buffer
()
(
nnheader-set-temp-buffer
gnus-async-prefetch-article-buffer
t
))
(
nnheader-set-temp-buffer
gnus-async-prefetch-article-buffer
t
)
(
unless
gnus-asynch-obarray
(
set
(
make-local-variable
'gnus-asynch-obarray
)
(
gnus-make-hashtable
1023
))))
(
defun
gnus-async-halt-prefetch
()
"Stop prefetching."
...
...
@@ -209,10 +215,13 @@ It should return non-nil if the article is to be prefetched."
(
when
arg
(
gnus-async-set-buffer
)
(
gnus-async-with-semaphore
(
push
(
list
',
(
intern
(
format
"%s-%d"
group
article
))
,
mark
(
set-marker
(
make-marker
)
(
point-max
))
,
group
,
article
)
gnus-async-article-alist
)))
(
setq
gnus-async-article-alist
(
cons
(
list
',
(
intern
(
format
"%s-%d"
group
article
)
gnus-asynch-obarray
)
,
mark
(
set-marker
(
make-marker
)
(
point-max
))
,
group
,
article
)
gnus-async-article-alist
))))
(
if
(
not
(
gnus-buffer-live-p
,
summary
))
(
gnus-async-with-semaphore
(
setq
gnus-async-fetch-list
nil
))
...
...
@@ -259,8 +268,11 @@ It should return non-nil if the article is to be prefetched."
(
defun
gnus-async-prefetched-article-entry
(
group
article
)
"Return the entry for ARTICLE in GROUP iff it has been prefetched."
(
let
((
entry
(
assq
(
intern
(
format
"%s-%d"
group
article
))
gnus-async-article-alist
)))
(
let
((
entry
(
save-excursion
(
gnus-async-set-buffer
)
(
assq
(
intern
(
format
"%s-%d"
group
article
)
gnus-asynch-obarray
)
gnus-async-article-alist
))))
;; Perhaps something has emptied the buffer?
(
if
(
and
entry
(
=
(
cadr
entry
)
(
caddr
entry
)))
...
...
lisp/gnus/gnus-audio.el
View file @
6748645f
...
...
@@ -2,7 +2,6 @@
;; Copyright (C) 1996 Free Software Foundation
;; Author: Steven L. Baur <steve@miranova.com>
;; Keywords: news
;; This file is part of GNU Emacs.
...
...
@@ -42,12 +41,12 @@
"The directory containing the Sound Files."
)
(
defvar
gnus-audio-au-player
"/usr/bin/showaudio"
"Executable program for playing sun AU format sound files"
)
(
defvar
gnus-audio-wav-player
"/usr/local/bin/play"
"Executable program for playing WAV files"
)
"Executable program for playing sun AU format sound files."
)
(
defvar
gnus-audio-wav-player
"/usr/local/bin/play"
"Executable program for playing WAV files."
)
;;; The following isn't implemented yet. Wait for
Red
Gnus.
;;; The following isn't implemented yet. Wait for
Millennium
Gnus.
;(defvar gnus-audio-effects-enabled t
; "When t, Gnus will use sound effects.")
;(defvar gnus-audio-enable-hooks nil
...
...
@@ -71,14 +70,14 @@
; "Enable Sound Effects for Gnus."
; (interactive)
; (setq gnus-audio-effects-enabled t)
; (run-hooks gnus-audio-enable-hooks))
; (
gnus-
run-hooks gnus-audio-enable-hooks))
;;;###autoload
;(defun gnus-audio-disable-sound ()
; "Disable Sound Effects for Gnus."
; (interactive)
; (setq gnus-audio-effects-enabled nil)
; (run-hooks gnus-audio-disable-hooks))
; (
gnus-
run-hooks gnus-audio-disable-hooks))
;;;###autoload
(
defun
gnus-audio-play
(
file
)
...
...
lisp/gnus/gnus-bcklg.el
View file @
6748645f
;;; gnus-bcklg.el --- backlog functions for Gnus
;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Copyright (C) 1996,97
,98
Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@
ifi.uio.no
>
;; Author: Lars Magne Ingebrigtsen <larsi@
gnus.org
>
;; Keywords: news
;; This file is part of GNU Emacs.
...
...
@@ -27,6 +27,8 @@
(
eval-when-compile
(
require
'cl
))
(
eval-when-compile
(
require
'cl
))
(
require
'gnus
)
;;;
...
...
@@ -41,10 +43,9 @@
"Return the backlog buffer."
(
or
(
get-buffer
gnus-backlog-buffer
)
(
save-excursion
(
set-buffer
(
get-buffer-create
gnus-backlog-buffer
))
(
set-buffer
(
gnus-
get-buffer-create
gnus-backlog-buffer
))
(
buffer-disable-undo
(
current-buffer
))
(
setq
buffer-read-only
t
)
(
gnus-add-current-to-buffer-list
)
(
get-buffer
gnus-backlog-buffer
))))
(
defun
gnus-backlog-setup
()
...
...
@@ -122,7 +123,8 @@
(
1+
beg
)
'gnus-backlog
(
current-buffer
)
(
point-max
)))
(
delete-region
beg
end
)
;; Return success.
t
)))))))
t
))
(
setq
gnus-backlog-articles
(
delq
ident
gnus-backlog-articles
)))))))
(
defun
gnus-backlog-request-article
(
group
number
buffer
)
(
when
(
numberp
number
)
...
...
lisp/gnus/gnus-cache.el
View file @
6748645f
;;; gnus-cache.el --- cache interface for Gnus
;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Copyright (C) 1995,96,97
,98
Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@
ifi.uio.no
>
;; Author: Lars Magne Ingebrigtsen <larsi@
gnus.org
>
;; Keywords: news
;; This file is part of GNU Emacs.
...
...
@@ -27,6 +27,8 @@
(
eval-when-compile
(
require
'cl
))
(
eval-when-compile
(
require
'cl
))
(
require
'gnus
)
(
require
'gnus-int
)
(
require
'gnus-range
)
...
...
@@ -34,16 +36,6 @@
(
eval-when-compile
(
require
'gnus-sum
))
(
defgroup
gnus-cache
nil
"Cache interface."
:group
'gnus
)
(
defcustom
gnus-cache-directory
(
nnheader-concat
gnus-directory
"cache/"
)
"*The directory where cached articles will be stored."
:group
'gnus-cache
:type
'directory
)
(
defcustom
gnus-cache-active-file
(
concat
(
file-name-as-directory
gnus-cache-directory
)
"active"
)
"*The cache active file."
...
...
@@ -60,15 +52,33 @@
:group
'gnus-cache
:type
'
(
set
(
const
ticked
)
(
const
dormant
)
(
const
unread
)
(
const
read
)))
(
defcustom
gnus-cacheable-groups
nil
"*Groups that match this regexp will be cached.
If you only want to cache your nntp groups, you could set this
variable to \"^nntp\".
If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
it's not cached."
:group
'gnus-cache
:type
'
(
choice
(
const
:tag
"off"
nil
)
regexp
))
(
defcustom
gnus-uncacheable-groups
nil
"*Groups that match this regexp will not be cached.
If you want to avoid caching your nnml groups, you could set this
variable to \"^nnml\"."
variable to \"^nnml\".
If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
it's not cached."
:group
'gnus-cache
:type
'
(
choice
(
const
:tag
"off"
nil
)
regexp
))
(
defvar
gnus-cache-overview-coding-system
'raw-text
"Coding system used on Gnus cache files."
)
;;; Internal variables.
...
...
@@ -116,7 +126,9 @@ variable to \"^nnml\"."
(
set-buffer
buffer
)
(
if
(
>
(
buffer-size
)
0
)
;; Non-empty overview, write it to a file.
(
gnus-write-buffer
overview-file
)
(
let
((
coding-system-for-write
gnus-cache-overview-coding-system
))
(
gnus-write-buffer
overview-file
))
;; Empty overview file, remove it
(
when
(
file-exists-p
overview-file
)
(
delete-file
overview-file
))
...
...
@@ -145,11 +157,13 @@ variable to \"^nnml\"."
headers
(
copy-sequence
headers
))
(
mail-header-set-number
headers
(
cdr
result
))))
(
let
((
number
(
mail-header-number
headers
))
file
dir
)
file
)
(
when
(
and
number
(
>
number
0
)
; Reffed article.
(
or
force
(
and
(
or
(
not
gnus-uncacheable-groups
)
(
and
(
or
(
not
gnus-cacheable-groups
)
(
string-match
gnus-cacheable-groups
group
))
(
or
(
not
gnus-uncacheable-groups
)
(
not
(
string-match
gnus-uncacheable-groups
group
)))
(
gnus-cache-member-of-class
...
...
@@ -157,7 +171,7 @@ variable to \"^nnml\"."
(
not
(
file-exists-p
(
setq
file
(
gnus-cache-file-name
group
number
)))))
;; Possibly create the cache directory.
(
gnus-make-directory
(
setq
dir
(
file-name-directory
file
))
)
(
gnus-make-directory
(
file-name-directory
file
))
;; Save the article in the cache.
(
if
(
file-exists-p
file
)
t
; The article already is saved.
...
...
@@ -316,10 +330,10 @@ variable to \"^nnml\"."
If not given a prefix, use the process marked articles instead.
Returns the list of articles entered."
(
interactive
"P"
)
(
gnus-set-global-variables
)
(
let
((
articles
(
gnus-summary-work-articles
n
))
article
out
)
(
while
(
setq
article
(
pop
articles
))
(
gnus-summary-remove-process-mark
article
)
(
if
(
natnump
article
)
(
when
(
gnus-cache-possibly-enter-article
gnus-newsgroup-name
article
...
...
@@ -327,7 +341,6 @@ Returns the list of articles entered."
nil
nil
nil
t
)
(
push
article
out
))
(
gnus-message
2
"Can't cache article %d"
article
))
(
gnus-summary-remove-process-mark
article
)
(
gnus-summary-update-secondary-mark
article
))
(
gnus-summary-next-subject
1
)
(
gnus-summary-position-point
)
...
...
@@ -338,15 +351,14 @@ Returns the list of articles entered."
If not given a prefix, use the process marked articles instead.
Returns the list of articles removed."
(
interactive
"P"
)
(
gnus-set-global-variables
)
(
gnus-cache-change-buffer
gnus-newsgroup-name
)
(
let
((
articles
(
gnus-summary-work-articles
n
))
article
out
)
(
while
articles
(
setq
article
(
pop
articles
))
(
gnus-summary-remove-process-mark
article
)
(
when
(
gnus-cache-possibly-remove-article
article
nil
nil
nil
t
)
(
push
article
out
))
(
gnus-summary-remove-process-mark
article
)
(
gnus-summary-update-secondary-mark
article
))
(
gnus-summary-next-subject
1
)
(
gnus-summary-position-point
)
...
...
@@ -359,13 +371,16 @@ Returns the list of articles removed."
(
defun
gnus-summary-insert-cached-articles
()
"Insert all the articles cached for this group into the current buffer."
(
interactive
)
(
let
((
cached
gnus-newsgroup-cached
)
(
let
((
cached
(
sort
(
copy-sequence
gnus-newsgroup-cached
)
'<
))
(
gnus-verbose
(
max
6
gnus-verbose
)))
(
unless
cached
(
error
"No cached articles for this group"
))
(
gnus-message
3
"No cached articles for this group"
))
(
while
cached
(
gnus-summary-goto-subject
(
pop
cached
)
t
))))
(
defalias
'gnus-summary-limit-include-cached
'gnus-summary-insert-cached-articles
)
;;; Internal functions.
(
defun
gnus-cache-change-buffer
(
group
)
...
...
@@ -380,7 +395,8 @@ Returns the list of articles removed."
(
save-excursion
(
setq
gnus-cache-buffer
(
cons
group
(
set-buffer
(
get-buffer-create
" *gnus-cache-overview*"
))))
(
set-buffer
(
gnus-get-buffer-create
" *gnus-cache-overview*"
))))
(
buffer-disable-undo
(
current-buffer
))
;; Insert the contents of this group's cache overview.
(
erase-buffer
)
...
...
@@ -408,12 +424,14 @@ Returns the list of articles removed."
;; Translate the first colon into a slash.
(
when
(
string-match
":"
group
)
(
aset
group
(
match-beginning
0
)
?/
))
(
nnheader-replace-chars-in-string
group
?.
?/
)))))
(
nnheader-replace-chars-in-string
group
?.
?/
)))
t
))
(
if
(
stringp
article
)
article
(
int-to-string
article
))))
(
defun
gnus-cache-update-article
(
group
article
)
"If ARTICLE is in the cache, remove it and re-enter it."
(
when
(
gnus-cache-possibly-remove-article
article
nil
nil
nil
t
)
(
gnus-cache-change-buffer
group
)
(
when
(
gnus-cache-possibly-remove-article
article
nil
nil
nil
t
)
(
let
((
gnus-use-cache
nil
))
(
gnus-cache-possibly-enter-article
gnus-newsgroup-name
article
(
gnus-summary-article-header
article
)
...
...
@@ -466,7 +484,7 @@ Returns the list of articles removed."
articles
)))
(
defun
gnus-cache-braid-nov
(
group
cached
&optional
file
)
(
let
((
cache-buf
(
get-buffer-create
" *gnus-cache*"
))
(
let
((
cache-buf
(
gnus-
get-buffer-create
" *gnus-cache*"
))
beg
end
)
(
gnus-cache-save-buffers
)
(
save-excursion
...
...
@@ -498,7 +516,7 @@ Returns the list of articles removed."
(
kill-buffer
cache-buf
)))
(
defun
gnus-cache-braid-heads
(
group
cached
)
(
let
((
cache-buf
(
get-buffer-create
" *gnus-cache*"
)))
(
let
((
cache-buf
(
gnus-
get-buffer-create
" *gnus-cache*"
)))
(
save-excursion
(
set-buffer
cache-buf
)
(
buffer-disable-undo
(
current-buffer
))
...
...
@@ -560,6 +578,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
"Read the cache active file."
(
gnus-make-directory
gnus-cache-directory
)
(
if
(
or
(
not
(
file-exists-p
gnus-cache-active-file
))
(
zerop
(
nth
7
(
file-attributes
gnus-cache-active-file
)))
force
)
;; There is no active file, so we generate one.
(
gnus-cache-generate-active
)
...
...
@@ -614,8 +633,9 @@ If LOW, update the lower bound instead."
(
if
top
""
(
string-match
(
concat
"^"
(
file-name-as-directory
(
expand-file-name
gnus-cache-directory
)))
(
concat
"^"
(
regexp-quote
(
file-name-as-directory
(
expand-file-name
gnus-cache-directory
))))
(
directory-file-name
directory
))
(
nnheader-replace-chars-in-string
(
substring
(
directory-file-name
directory
)
(
match-end
0
))
...
...
@@ -624,6 +644,8 @@ If LOW, update the lower bound instead."
(
when
top
(
gnus-message
5
"Generating the cache active file..."
)
(
setq
gnus-cache-active-hashtb
(
gnus-make-hashtable
123
)))
(
when
(
string-match
"^\\(nn[^_]+\\)_"
group
)
(
setq
group
(
replace-match
"\\1:"
t
t
group
)))
;; Separate articles from all other files and directories.
(
while
files
(
if
(
string-match
"^[0-9]+$"
(
file-name-nondirectory
(
car
files
)))
...
...
@@ -636,7 +658,7 @@ If LOW, update the lower bound instead."
;; Go through all the other files.
(
while
alphs
(
when
(
and
(
file-directory-p
(
car
alphs
))
(
not
(
string-match
"^\\.
\\.?$
"
(
not
(
string-match
"^\\."
(
file-name-nondirectory
(
car
alphs
)))))
;; We descend directories.
(
gnus-cache-generate-active
(
car
alphs
)))
...
...
lisp/gnus/gnus-cite.el
View file @
6748645f
;;; gnus-cite.el --- parse citations in articles for Gnus
;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Copyright (C) 1995,96,97
,98
Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; Author: Per Abhiddenware; 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.
...
...
@@ -27,6 +22,8 @@
(
eval-when-compile
(
require
'cl
))
(
eval-when-compile
(
require
'cl
))
(
require
'gnus
)
(
require
'gnus-art
)
(
require
'gnus-range
)
...
...
@@ -41,7 +38,7 @@
(
defcustom
gnus-cite-reply-regexp
"^\\(Subject: Re\\|In-Reply-To\\|References\\):"
"If headers match this regexp it is reasonable to believe that
"
*
If headers match this regexp it is reasonable to believe that
article has citations."
:group
'gnus-cite
:type
'string
)
...
...
@@ -52,8 +49,13 @@ article has citations."
:type
'
(
choice
(
const
:tag
"no"
nil
)
(
const
:tag
"yes"
t
)))
(
defcustom
gnus-cited-text-button-line-format
"%(%{[...]%}%)\n"
"Format of cited text buttons."
(
defcustom
gnus-cited-opened-text-button-line-format
"%(%{[-]%}%)\n"
"Format of opened cited text buttons."
:group
'gnus-cite
:type
'string
)
(
defcustom
gnus-cited-closed-text-button-line-format
"%(%{[+]%}%)\n"
"Format of closed cited text buttons."
:group
'gnus-cite
:type
'string
)
...
...
@@ -71,8 +73,8 @@ Set it to nil to parse all articles."
integer
))
(
defcustom
gnus-cite-prefix-regexp
"^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
"Regexp matching the longest possible citation prefix on a line."
"^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
"
*
Regexp matching the longest possible citation prefix on a line."
:group
'gnus-cite
:type
'regexp
)
...
...
@@ -84,7 +86,7 @@ Set it to nil to parse all articles."
(
defcustom
gnus-supercite-regexp
(
concat
"^\\("
gnus-cite-prefix-regexp
"\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +=="
)
"Regexp matching normal Supercite attribution lines.
"
*
Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
:group
'gnus-cite
:type
'regexp
)
...
...
@@ -100,21 +102,21 @@ The first regexp group should match the Supercite attribution."
:group
'gnus-cite
:type
'integer
)
(
defcustom
gnus-cite-attribution-prefix
"
i
n article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),"
"Regexp matching the beginning of an attribution line."
(
defcustom
gnus-cite-attribution-prefix
"
I
n 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\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[
]*$"
"Regexp matching the end of an attribution line.
"\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[
\t
]*$"
"
*
Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group
'gnus-cite
:type
'regexp
)
(
defface
gnus-cite-attribution-face
'
((
t
(
:
underline
t
)))
(
:
italic
t
)))
"Face used for attribution lines."
)
(
defcustom
gnus-cite-attribution-face
'gnus-cite-attribution-face
...
...
@@ -237,7 +239,7 @@ It is merged with the face for the cited text belonging to the attribution."
'
(
gnus-cite-face-1
gnus-cite-face-2
gnus-cite-face-3
gnus-cite-face-4
gnus-cite-face-5
gnus-cite-face-6
gnus-cite-face-7
gnus-cite-face-8
gnus-cite-face-9
gnus-cite-face-10
gnus-cite-face-11
)
"List of faces used for highlighting citations.
"
*
List of faces used for highlighting citations.
When there are citations from multiple articles in the same message,
Gnus will try to give each citation from each article its own face.
...
...
@@ -258,6 +260,7 @@ This should make it easier to see who wrote what."
;;; Internal Variables:
(
defvar
gnus-cite-article
nil
)
(
defvar
gnus-cite-overlay-list
nil
)
(
defvar
gnus-cite-prefix-alist
nil
)
;; Alist of citation prefixes.
...
...
@@ -280,11 +283,16 @@ This should make it easier to see who wrote what."
;; PREFIX: Is the citation prefix of the attribution line(s), and
;; TAG: Is a Supercite tag, if any.
(
defvar
gnus-cited-text-button-line-format-alist
(
defvar
gnus-cited-
opened-
text-button-line-format-alist
`
((
?b
(
marker-position
beg
)
?d
)
(
?e
(
marker-position
end
)
?d
)
(
?n
(
count-lines
beg
end
)
?d
)
(
?l
(
-
end
beg
)
?d
)))
(
defvar
gnus-cited-text-button-line-format-spec
nil
)
(
defvar
gnus-cited-opened-text-button-line-format-spec
nil
)
(
defvar
gnus-cited-closed-text-button-line-format-alist
gnus-cited-opened-text-button-line-format-alist
)
(
defvar
gnus-cited-closed-text-button-line-format-spec
nil
)
;;; Commands:
...
...
@@ -383,7 +391,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(
gnus-article-search-signature
)
(
push
(
cons
(
point-marker
)
""
)
marks
)
;; Sort the marks.
(
setq
marks
(
sort
marks
(
lambda
(
m1
m2
)
(
<
(
car
m1
)
(
car
m2
)))
))
(
setq
marks
(
sort
marks
'car-less-than-car
))
(
let
((
omarks
marks
))
(
setq
marks
nil
)
(
while
(
cdr
omarks
)
...
...
@@ -449,9 +457,8 @@ See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix,
always hide."
(
interactive
(
append
(
gnus-article-hidden-arg
)
(
list
'force
)))
(
setq
gnus-cited-text-button-line-format-spec
(
gnus-parse-format
gnus-cited-text-button-line-format
gnus-cited-text-button-line-format-alist
t
))
(
gnus-set-format
'cited-opened-text-button
t
)
(
gnus-set-format
'cited-closed-text-button
t
)
(
save-excursion
(
set-buffer
gnus-article-buffer
)
(
cond
...
...
@@ -466,7 +473,7 @@ always hide."
(
inhibit-point-motion-hooks
t
)
(
props
(
nconc
(
list
'article-type
'cite
)
gnus-hidden-properties
))
beg
end
)
beg
end
start
)
(
while
marks
(
setq
beg
nil
end
nil
)
...
...
@@ -486,30 +493,58 @@ always hide."
(
setq
beg
nil
)
(
setq
beg
(
point-marker
))))
(
when
(
and
beg
end
)
;; We use markers for the end-points to facilitate later
;; wrapping and mangling of text.
(
setq
beg
(
set-marker
(
make-marker
)
beg
)
end
(
set-marker
(
make-marker
)
end
))
(
gnus-add-text-properties
beg
end
props
)
(
goto-char
beg
)
(
unless
(
save-excursion
(
search-backward
"\n\n"
nil
t
))
(
insert
"\n"
))
(
put-text-property
(
point
)
(
setq
start
(
point-marker
)
)
(
progn
(
gnus-article-add-button
(
point
)
(
progn
(
eval
gnus-cited-text-button-line-format-spec
)
(
point
))
`
gnus-article-toggle-cited-text
(
cons
beg
end
))
(
progn
(
eval
gnus-cited-closed-text-button-line-format-spec
)
(
point
))
`
gnus-article-toggle-cited-text
(
list
(
cons
beg
end
)
start
))
(
point
))
'article-type
'annotation
)
(
set-marker
beg
(
point
)))))))))
(
defun
gnus-article-toggle-cited-text
(
region
)
(
defun
gnus-article-toggle-cited-text
(
args
)
"Toggle hiding the text in REGION."
(
let
(
buffer-read-only
)
(
let*
((
region
(
car
args
))
(
start
(
cadr
args
))
(
hidden
(
text-property-any
(
car
region
)
(
1-
(
cdr
region
))
(
car
gnus-hidden-properties
)
(
cadr
gnus-hidden-properties
)))
(
inhibit-point-motion-hooks
t
)
buffer-read-only
)
(
funcall
(
if
(
text-property-any
(
car
region
)
(
1-
(
cdr
region
))
(
car
gnus-hidden-properties
)
(
cadr
gnus-hidden-properties
))
(
if
hidden
'remove-text-properties
'gnus-add-text-properties
)
(
car
region
)
(
cdr
region
)
gnus-hidden-properties
)))
(
car
region
)
(
cdr
region
)
gnus-hidden-properties
)
(
save-excursion
(
goto-char
start
)
(
gnus-delete-line
)
(
put-text-property
(
point
)
(
progn
(
gnus-article-add-button
(
point
)
(
progn
(
eval
(
if
hidden
gnus-cited-opened-text-button-line-format-spec
gnus-cited-closed-text-button-line-format-spec
))
(
point
))
`
gnus-article-toggle-cited-text
args
)
(
point
))
'article-type
'annotation
))))
(
defun
gnus-article-hide-citation-maybe
(
&optional
arg
force
)
"Toggle hiding of cited text that has an attribution line.
...
...
@@ -520,7 +555,7 @@ percent and at least `gnus-cite-hide-absolute' lines of the body is
cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
(
interactive
(
append
(
gnus-article-hidden-arg
)
(
list
'force
)))