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/gitweb/?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>ZDNet/\\(JAPAN\\|USA\\)\\]\\(<[^>]+>\\)?\\)")) ("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"