summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog45
-rw-r--r--lisp/gnus/gnus-agent.el5
-rw-r--r--lisp/gnus/gnus-cus.el63
-rw-r--r--lisp/gnus/gnus-sum.el33
-rw-r--r--lisp/gnus/gnus.el11
-rw-r--r--lisp/gnus/mm-util.el6
-rw-r--r--lisp/gnus/nnmbox.el134
7 files changed, 218 insertions, 79 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 0cf879fd264..1def50da1e3 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,48 @@
+2007-10-08 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936.
+
+2007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * Relicense "GPLv2 or later" files to "GPLv3 or later".
+
+2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el.
+ Suggested by Leo <sdl.web@gmail.com>.
+
+ * gnus.el: Do.
+
+2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-newsgroup-maximum-articles): Rename from
+ gnus-maximum-newsgroup. Suggested by Leo <sdl.web@gmail.com>.
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Do.
+
+ * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles)
+ (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Do.
+
+2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnmbox.el (nnmbox-request-article): Don't assume delim regexp matches
+ newline.
+ (nnmbox-request-accept-article): Don't change article in source buffer;
+ narrow to header to use message-fetch-field rather than
+ nnmail-fetch-field; use with-current-buffer instead of save-excursion.
+ (nnmbox-request-replace-article): Quote lines that'll be misidentified
+ as delimiters; make sure article ends with newline.
+ (nnmbox-delete-mail): Correct last position of article to be deleted;
+ ignore X-Gnus-Newsgroup header in article body.
+ (nnmbox-save-mail): Quote lines looking like delimiters at the right
+ positions; make sure article ends with newline.
+
+2007-09-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cus.el (gnus-score-extra): New widget.
+ (gnus-score-extra-convert): New function.
+ (gnus-score-customize): Use it for Extra.
+
2007-08-23 Katsumi Yamaoka <yamaoka@jpl.org>
* mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 347b57983e6..21b442aebbb 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1765,12 +1765,13 @@ article numbers will be returned."
(gnus-agent-find-parameter group
'agent-predicate)))))
(articles (if fetch-all
- (if gnus-maximum-newsgroup
+ (if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
(gnus-uncompress-range
(cons (max (car active)
(- (cdr active)
- gnus-maximum-newsgroup -1))
+ gnus-newsgroup-maximum-articles
+ -1))
(cdr active))))
(gnus-uncompress-range (gnus-active group)))
(gnus-list-of-unread-articles group)))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index f1719eb04f4..1470f0cbac1 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -766,6 +766,67 @@ eh?")))
,group))))
widget)
+(define-widget 'gnus-score-extra 'group
+ "Edit score entries for extra headers."
+ :convert-widget 'gnus-score-extra-convert)
+
+(defun gnus-score-extra-convert (widget)
+ ;; Set args appropriately.
+ (let* ((tag (widget-get widget :tag))
+ (item `(const :format "" :value ,(downcase tag)))
+ (match '(string :tag "Match"))
+ (score '(choice :tag "Score"
+ (const :tag "default" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (expire '(choice :tag "Expire"
+ (const :tag "off" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (type '(choice :tag "Type"
+ :value s
+ ;; I should really create a forgiving :match
+ ;; function for each type below, that only
+ ;; looked at the first letter.
+ (const :tag "Regexp" r)
+ (const :tag "Regexp (fixed case)" R)
+ (const :tag "Substring" s)
+ (const :tag "Substring (fixed case)" S)
+ (const :tag "Exact" e)
+ (const :tag "Exact (fixed case)" E)
+ (const :tag "Word" w)
+ (const :tag "Word (fixed case)" W)
+ (const :tag "default" nil)))
+ (header (if gnus-extra-headers
+ (let (name)
+ `(choice :tag "Header"
+ ,@(mapcar (lambda (h)
+ (setq name (symbol-name h))
+ (list 'const :tag name name))
+ gnus-extra-headers)
+ (string :tag "Other" :format "%v")))
+ '(string :tag "Header")))
+ (group `(group ,match ,score ,expire ,type ,header))
+ (doc (concat (or (widget-get widget :doc)
+ (concat "Change score based on the " tag
+ " header.\n")))))
+ (widget-put
+ widget :args
+ `(,item
+ (repeat :inline t
+ :indent 0
+ :tag ,tag
+ :doc ,doc
+ :format "%t:\n%h%v%i\n\n"
+ (choice :format "%v"
+ :value ("" nil nil s
+ ,(if gnus-extra-headers
+ (symbol-name (car gnus-extra-headers))
+ ""))
+ ,group
+ sexp)))))
+ widget)
+
(defvar gnus-custom-scores)
(defvar gnus-custom-score-alist)
@@ -822,7 +883,7 @@ if you do all your changes will be lost. ")
(gnus-score-string :tag "Subject")
(gnus-score-string :tag "References")
(gnus-score-string :tag "Xref")
- (gnus-score-string :tag "Extra")
+ (gnus-score-extra :tag "Extra")
(gnus-score-string :tag "Message-ID")
(gnus-score-integer :tag "Lines")
(gnus-score-integer :tag "Chars")
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 851ec88c96f..36e93796a63 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1029,6 +1029,17 @@ default charset will be used instead."
:type '(repeat symbol)
:group 'gnus-charset)
+(defcustom gnus-newsgroup-maximum-articles nil
+ "The maximum number of articles a newsgroup.
+If this is a number, old articles in a newsgroup exceeding this number
+are silently ignored. If it is nil, no article is ignored. Note that
+setting this variable to a number might prevent you from reading very
+old articles."
+ :group 'gnus-group-select
+ :version "22.2"
+ :type '(choice (const :tag "No limit" nil)
+ integer))
+
(gnus-define-group-parameter
ignored-charsets
:type list
@@ -5472,11 +5483,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; articles in the group, or (if that's nil), the
;; articles in the cache.
(or
- (if gnus-maximum-newsgroup
+ (if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
(gnus-uncompress-range
(cons (max (car active)
- (- (cdr active) gnus-maximum-newsgroup -1))
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
(cdr active))))
(gnus-uncompress-range (gnus-active group)))
(gnus-cache-articles-in-group group))
@@ -6540,8 +6553,9 @@ displayed, no centering will be performed."
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
- (bottom (if gnus-maximum-newsgroup
- (max (car active) (- last gnus-maximum-newsgroup -1))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
(car active)))
first nlast unread)
;; If none are read, then all are unread.
@@ -6585,9 +6599,11 @@ displayed, no centering will be performed."
(gnus-list-range-difference
(gnus-sorted-complement
(gnus-uncompress-range
- (if gnus-maximum-newsgroup
+ (if gnus-newsgroup-maximum-articles
(cons (max (car active)
- (- (cdr active) gnus-maximum-newsgroup -1))
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
(cdr active))
active))
(gnus-list-of-unread-articles group))
@@ -6601,8 +6617,9 @@ displayed, no centering will be performed."
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
- (bottom (if gnus-maximum-newsgroup
- (max (car active) (- last gnus-maximum-newsgroup -1))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
(car active)))
first nlast unread)
;; If none are read, then all are unread.
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 3f75bba6d1c..0e8e9908cf4 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1501,17 +1501,6 @@ If it is nil, no confirmation is required."
:type '(choice (const :tag "No limit" nil)
integer))
-(defcustom gnus-maximum-newsgroup nil
- "The maximum number of articles a newsgroup.
-If this is a number, old articles in a newsgroup exceeding this number
-are silently ignored. If it is nil, no article is ignored. Note that
-setting this variable to a number might prevent you from reading very
-old articles."
- :group 'gnus-group-select
- :version "22.2"
- :type '(choice (const :tag "No limit" nil)
- integer))
-
(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
"*Non-nil means that the default name of a file to save articles in is the group name.
If it's nil, the directory form of the group name is used instead.
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 76b1f2779c9..04a600abf25 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -256,6 +256,12 @@ the alias. Else windows-NUMBER is used."
,@(when (and (not (mm-coding-system-p 'windows-31j))
(mm-coding-system-p 'cp932))
'((windows-31j . cp932)))
+ ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
+ ;; http://www.iana.org/assignments/charset-reg/GBK
+ ;; Emacs 22.1 has cp936, but not gbk, so we alias it:
+ ,@(when (and (not (mm-coding-system-p 'gbk))
+ (mm-coding-system-p 'cp936))
+ '((gbk . cp936)))
)
"A mapping from unknown or invalid charset names to the real charset names.
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 6127974d24a..fd8ec27d225 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -153,11 +153,11 @@
(re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
(setq start (point))
(forward-line 1)
- (or (and (re-search-forward
- (concat "^" message-unix-mail-delimiter) nil t)
- (forward-line -1))
- (goto-char (point-max)))
- (setq stop (point))
+ (setq stop (if (re-search-forward (concat "^"
+ message-unix-mail-delimiter)
+ nil 'move)
+ (match-beginning 0)
+ (point)))
(let ((nntp-server-buffer (or buffer nntp-server-buffer)))
(set-buffer nntp-server-buffer)
(erase-buffer)
@@ -313,39 +313,45 @@
(nnmbox-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
- result)
- (goto-char (point-min))
- ;; The From line may have been quoted by movemail.
- (when (looking-at (concat ">" message-unix-mail-delimiter))
- (delete-char 1))
- (if (looking-at "X-From-Line: ")
- (replace-match "From ")
- (insert "From nobody " (current-time-string) "\n"))
+ result cont)
(and
(nnmail-activate 'nnmbox)
- (progn
- (set-buffer buf)
+ (with-temp-buffer
+ (insert-buffer-substring buf)
(goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-line -1)
+ (cond (;; The From line may have been quoted by movemail.
+ (looking-at (concat ">" message-unix-mail-delimiter))
+ (delete-char 1)
+ (forward-line 1))
+ ((looking-at "X-From-Line: ")
+ (replace-match "From ")
+ (forward-line 1))
+ (t
+ (insert "From nobody " (current-time-string) "\n")))
+ (narrow-to-region (point)
+ (if (search-forward "\n\n" nil 'move)
+ (1- (point))
+ (point)))
(while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ (nnmail-cache-insert (message-fetch-field "message-id")
group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
+ (message-fetch-field "subject")
+ (message-fetch-field "from")))
+ (widen)
(setq result (if (stringp group)
(list (cons group (nnmbox-active-number group)))
(nnmail-article-group 'nnmbox-active-number)))
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nnmbox-save-mail result)))))
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (prog1
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nnmbox-save-mail result))))
+ (setq cont (buffer-string))))
+ (with-current-buffer nnmbox-mbox-buffer
(goto-char (point-max))
- (insert-buffer-substring buf)
+ (insert cont)
(when last
(when nnmail-cache-accepted-message-ids
(nnmail-cache-close))
@@ -360,7 +366,20 @@
(if (not (nnmbox-find-article article))
nil
(nnmbox-delete-mail t t)
- (insert-buffer-substring buffer)
+ (insert
+ (with-temp-buffer
+ (insert-buffer-substring buffer)
+ (goto-char (point-min))
+ (when (looking-at "X-From-Line:")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (while (re-search-forward (concat "^" message-unix-mail-delimiter)
+ nil t)
+ (goto-char (match-beginning 0))
+ (insert ">"))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (buffer-string)))
(nnmbox-save-buffer)
t)))
@@ -430,21 +449,20 @@
(save-excursion
(save-restriction
(narrow-to-region
- (save-excursion
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (if leave-delim (progn (forward-line 1) (point))
- (match-beginning 0)))
- (progn
- (forward-line 1)
- (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
- nil t)
- (if (and (not (bobp)) leave-delim)
- (progn (forward-line -2) (point))
- (match-beginning 0)))
- (point-max))))
+ (prog2
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (if leave-delim (progn (forward-line 1) (point))
+ (match-beginning 0))
+ (forward-line 1))
+ (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
+ nil t)
+ (match-beginning 0))
+ (point-max)))
(goto-char (point-min))
;; Only delete the article if no other group owns it as well.
- (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+ (when (or force
+ (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))
+ (search-backward "\n\n" nil t))
(delete-region (point-min) (point-max))))))
(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
@@ -552,24 +570,26 @@
(let ((delim (concat "^" message-unix-mail-delimiter)))
(goto-char (point-min))
;; This might come from somewhere else.
- (unless (looking-at delim)
- (insert "From nobody " (current-time-string) "\n")
- (goto-char (point-min)))
+ (if (looking-at delim)
+ (forward-line 1)
+ (insert "From nobody " (current-time-string) "\n"))
;; Quote all "From " lines in the article.
- (forward-line 1)
(while (re-search-forward delim nil t)
- (beginning-of-line)
- (insert "> "))
- (nnmail-insert-lines)
- (nnmail-insert-xref group-art)
- (nnmbox-insert-newsgroup-line group-art)
- (let ((alist group-art))
- (while alist
- (nnmbox-record-active-article (car alist))
- (setq alist (cdr alist))))
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnmbox-prepare-save-mail-hook)
- group-art))
+ (goto-char (match-beginning 0))
+ (insert ">")))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (nnmail-insert-lines)
+ (nnmail-insert-xref group-art)
+ (nnmbox-insert-newsgroup-line group-art)
+ (let ((alist group-art))
+ (while alist
+ (nnmbox-record-active-article (car alist))
+ (setq alist (cdr alist))))
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnmbox-prepare-save-mail-hook)
+ group-art)
(defun nnmbox-insert-newsgroup-line (group-art)
(save-excursion
View Lorry Controller Status