From: yamaoka
Date: Mon, 21 Aug 2000 00:39:27 +0000 (+0000)
Subject: Synch with `t-gnus-6_14' and Gnus.
X-Git-Tag: t-gnus-6_14-quimby-before-installer-changed-~136
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=bbe00968f3b099c72051a4638fda6d42066cd272;p=elisp%2Fgnus.git-
Synch with `t-gnus-6_14' and Gnus.
---
diff --git a/ChangeLog b/ChangeLog
index 323f4fb..33ba2b5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2000-08-19 TSUCHIYA Masatoshi
+
+ * nnshimbun.el (nnshimbun-type-definition): Follow changes of ZDNet.
+ (nnshimbun-make-text-or-html-contents): Ditto.
+ (nnshimbun-make-html-contents): Ditto.
+
2000-08-18 TSUCHIYA Masatoshi
Akihiro Arisawa
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 55cf966..ac7455d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
+2000-08-20 Simon Josefsson
+
+ * nnimap.el (nnimap-before-find-minmax-bugworkaround): New
+ function, thanks to Lloyd Zusman for debugging.
+ (nnimap-request-group):
+ (nnimap-request-list):
+ (nnimap-retrieve-groups):
+ (nnimap-request-newgroups): Use it.
+
+ * nnimap.el (nnimap-request-article-part): Less verbose.
+
+2000-08-19 Andreas Jaeger
+
+ * lpath.el ((string-match "XEmacs" emacs-version)): Remove
+ subst-char-in-string since we test elsewhere whether it's bound.
+
+2000-08-18 Dave Love
+
+ * gnus-score.el (gnus-score-find-score-files-function): Fix doc,
+ custom type.
+
+ * gnus-xmas.el (gnus-group-icon-create-glyph): Don't test
+ gnus-group-running-xemacs.
+
+ * nnheader.el (nnheader-replace-chars-in-string): Use
+ subst-char-in-string if available.
+
+ * gnus-art.el (gnus-read-save-file-name, gnus-plain-save-name)
+ (gnus-request-article-this-buffer): Use expand-file-name.
+ (gnus-mime-view-part-as-type): Simplify interactive spec.
+ (gnus-mime-button-map): Define it all in defvar.
+
2000-08-17 Dave Love
* gnus-group.el (gnus-group-running-xemacs): Deleted.
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 64a2c46..4055dd3 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -212,6 +212,7 @@ regexp. If it matches, the text in question is not a signature."
(cond
;; Fixme: This isn't the right thing for mixed graphical and and
;; non-graphical frames in a session.
+ ;; gnus-xmas.el overrides this for XEmacs.
((and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm))
'gnus-article-display-xface)
@@ -2478,8 +2479,8 @@ This format is defined by the `gnus-article-time-format' variable."
(gnus-make-directory (file-name-directory file))
;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
- (setq file (concat (file-name-as-directory file)
- (file-name-nondirectory default-name))))
+ (setq file (expand-file-name (file-name-nondirectory default-name)
+ (file-name-as-directory file))))
;; Possibly translate some characters.
(nnheader-translate-file-chars file)))))
(gnus-make-directory (file-name-directory result))
@@ -2647,7 +2648,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(expand-file-name
(if (gnus-use-long-file-name 'not-save)
newsgroup
- (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+ (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
gnus-article-save-directory)))
(eval-and-compile
@@ -3220,15 +3221,14 @@ value of the variable `gnus-show-mime' is non-nil."
(format " (%d parts)" (length (mime-entity-children entity)))
""))))
-(defvar gnus-mime-button-map nil)
-(unless gnus-mime-button-map
- (setq gnus-mime-button-map (make-sparse-keymap))
- (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
- (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
- (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu)
- (mapcar (lambda (c)
- (define-key gnus-mime-button-map (cadr c) (car c)))
- gnus-mime-button-commands))
+(defvar gnus-mime-button-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map gnus-article-mode-map)
+ (define-key map gnus-mouse-2 'gnus-article-push-button)
+ (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+ (dolist (c gnus-mime-button-commands)
+ (define-key map (cadr c) (car c)))
+ map))
(defun gnus-mime-button-menu (event)
"Construct a context-sensitive menu of MIME commands."
@@ -3294,7 +3294,7 @@ value of the variable `gnus-show-mime' is non-nil."
(interactive
(list (completing-read
"View as MIME type: "
- (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+ (mapcar #'list (mailcap-mime-types))
nil nil
(gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
@@ -4165,11 +4165,11 @@ If given a prefix, show the hidden text instead."
gnus-newsgroup-name)))
(when (and (eq (car method) 'nneething)
(vectorp header))
- (let ((dir (concat
+ (let ((dir (expand-file-name
+ (mail-header-subject header)
(file-name-as-directory
(or (cadr (assq 'nneething-address method))
- (nth 1 method)))
- (mail-header-subject header))))
+ (nth 1 method))))))
(when (file-directory-p dir)
(setq article 'nneething)
(gnus-group-enter-directory dir))))))))
diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 57129eb..19c3b2c 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -108,8 +108,8 @@ gnus-score-find-bnews: Apply score files whose names matches.
See the documentation to these functions for more information.
This variable can also be a list of functions to be called. Each
-function should either return a list of score files, or a list of
-score alists.
+function is given the group name as argument and should either return
+a list of score files, or a list of score alists.
If functions other than these pre-defined functions are used,
the `a' symbolic prefix to the score commands will always use
@@ -118,7 +118,12 @@ the `a' symbolic prefix to the score commands will always use
:type '(radio (function-item gnus-score-find-single)
(function-item gnus-score-find-hierarchical)
(function-item gnus-score-find-bnews)
- (function :tag "Other")))
+ (repeat :tag "List of functions"
+ (choice (function :tag "Other" :value 'ignore)
+ (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)))
+ (function :tag "Other" :value 'ignore)))
(defcustom gnus-score-interactive-default-score 1000
"*Scoring commands will raise/lower the score with this number as the default."
diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 880a66f..2ade866 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -784,7 +784,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
"Regexp that matches numerical full file paths.")
(defsubst nnheader-file-to-number (file)
- "Take a file name and return the article number."
+ "Take a FILE name and return the article number."
(if (string= nnheader-numerical-short-files "^[0-9]+$")
(string-to-int file)
(string-match nnheader-numerical-short-files file)
@@ -802,7 +802,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
second)))
(defun nnheader-directory-articles (dir)
- "Return a list of all article files in a directory."
+ "Return a list of all article files in directory DIR."
(mapcar 'nnheader-file-to-number
(nnheader-directory-files-safe
dir nil nnheader-numerical-short-files t)))
@@ -829,7 +829,7 @@ If FULL, translate everything."
;; Do complete translation.
(setq leaf (copy-sequence file)
path ""
- i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
+ i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
2 0))
;; We translate -- but only the file name. We leave the directory
;; alone.
@@ -876,17 +876,20 @@ without formatting."
(apply 'insert format args))
t))
-(defun nnheader-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string))
+(if (fboundp 'subst-char-in-string)
+ (defsubst nnheader-replace-chars-in-string (string from to)
+ (subst-char-in-string from to string))
+ (defun nnheader-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (when (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string)))
(defun nnheader-replace-duplicate-chars-in-string (string from to)
"Replace characters in STRING from FROM to TO."
@@ -954,7 +957,7 @@ without formatting."
(and (listp form) (eq (car form) 'lambda))))
(defun nnheader-concat (dir &rest files)
- "Concat DIR as directory to FILE."
+ "Concat DIR as directory to FILES."
(apply 'concat (file-name-as-directory dir) files))
(defun nnheader-ms-strip-cr ()
@@ -1081,11 +1084,11 @@ find-file-hooks, etc.
(set-buffer cur)))
(defun nnheader-replace-string (from to)
- "Do a fast replacement of FROM to TO from point to point-max."
+ "Do a fast replacement of FROM to TO from point to `point-max'."
(nnheader-skeleton-replace from to))
(defun nnheader-replace-regexp (from to)
- "Do a fast regexp replacement of FROM to TO from point to point-max."
+ "Do a fast regexp replacement of FROM to TO from point to `point-max'."
(nnheader-skeleton-replace from to t))
(defun nnheader-strip-cr ()
diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 0a22b96..477e9af 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -330,6 +330,14 @@ If SERVER is nil, uses the current server."
(gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
t)))
+(defun nnimap-before-find-minmax-bugworkaround ()
+ "Function called before iterating through mailboxes with
+`nnimap-find-minmax-uid'."
+ ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
+ ;; currently selected mailbox without a re-select/examine.
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer)))
+
(defun nnimap-find-minmax-uid (group &optional examine)
"Find lowest and highest active article nummber in GROUP.
If EXAMINE is non-nil the group is selected read-only."
@@ -644,7 +652,7 @@ function is generally only called when Gnus is shutting down."
nnimap-server-buffer))
article)))
(when article
- (gnus-message 9 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
@@ -653,7 +661,7 @@ function is generally only called when Gnus is shutting down."
(when data
(insert (if detail (nth 2 (car data)) data))
(nnheader-ms-strip-cr)
- (gnus-message 9
+ (gnus-message 10
"nnimap: Fetching (part of) article %d...done"
article)
(if (bobp)
@@ -697,6 +705,7 @@ function is generally only called when Gnus is shutting down."
group (gnus-server-to-method (format "nnimap:%s" server))))
server)
(when (nnimap-possibly-change-group group server)
+ (nnimap-before-find-minmax-bugworkaround)
(let (info)
(cond (fast group)
((null (setq info (nnimap-find-minmax-uid group t)))
@@ -740,6 +749,7 @@ function is generally only called when Gnus is shutting down."
(erase-buffer))
(gnus-message 5 "nnimap: Generating active list%s..."
(if (> (length server) 0) (concat " for " server) ""))
+ (nnimap-before-find-minmax-bugworkaround)
(with-current-buffer nnimap-server-buffer
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
@@ -781,6 +791,7 @@ function is generally only called when Gnus is shutting down."
(gnus-message 5 "nnimap: Checking mailboxes...")
(with-current-buffer nntp-server-buffer
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (group groups)
(gnus-message 7 "nnimap: Checking mailbox %s" group)
(or (member "\\NoSelect"
@@ -982,6 +993,7 @@ function is generally only called when Gnus is shutting down."
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
(if (> (length server) 0) " on " "") server)
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
(dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
@@ -1244,6 +1256,7 @@ sure of changing the value of `foo'."
nnimap-possibly-change-server
nnimap-verify-uidvalidity
nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
nnimap-possibly-change-group
;;nnimap-replace-whitespace
nnimap-retrieve-headers-progress
diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index 3ca4016..be376c6 100644
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -122,8 +122,8 @@
(index-url . nnshimbun-url)
(from-address . "zdnn@softbank.co.jp")
(make-contents . nnshimbun-make-html-contents)
- (contents-start . "")
- (contents-end . ""))
+ (contents-start . "\\(\\|[0-9]+年[0-9]+月[0-9]+日[^<]*[ \t\r\f\n]*[ \t\r\f\n]*[ \t\r\f\n]*\\(
\\)?\\)")
+ (contents-end . "\\(\\|\\|<\\(b\\|strong\\)>\\[\\2>[^<]*<\\2>ZDNet/\\(JAPAN\\|USA\\)\\]\\(<[^>]+>\\)?\\2>\\)"))
("mew"
(url . "http://www.mew.org/archive/")
(groups ,@(mapcar #'car nnshimbun-mew-groups))
@@ -748,11 +748,11 @@ is enclosed by at least one regexp grouping construct."
(defun nnshimbun-make-text-or-html-contents (header &optional x-face)
(let ((case-fold-search t) (html t) (start))
- (when (and (search-forward nnshimbun-contents-start nil t)
+ (when (and (re-search-forward nnshimbun-contents-start nil t)
(setq start (point))
- (search-forward nnshimbun-contents-end nil t))
+ (re-search-forward nnshimbun-contents-end nil t))
+ (delete-region (match-beginning 0) (point-max))
(delete-region (point-min) start)
- (delete-region (- (point) (length nnshimbun-contents-end)) (point-max))
(nnshimbun-shallow-rendering)
(setq html nil))
(goto-char (point-min))
@@ -769,11 +769,11 @@ is enclosed by at least one regexp grouping construct."
(defun nnshimbun-make-html-contents (header &optional x-face)
(let (start)
- (when (and (search-forward nnshimbun-contents-start nil t)
+ (when (and (re-search-forward nnshimbun-contents-start nil t)
(setq start (point))
- (search-forward nnshimbun-contents-end nil t))
- (delete-region (point-min) start)
- (delete-region (- (point) (length nnshimbun-contents-end)) (point-max)))
+ (re-search-forward nnshimbun-contents-end nil t))
+ (delete-region (match-beginning 0) (point-max))
+ (delete-region (point-min) start))
(goto-char (point-min))
(nnshimbun-insert-header header)
(insert "Content-Type: text/html; charset=ISO-2022-JP\n"