From: yamaoka Date: Mon, 23 Jun 2003 22:54:13 +0000 (+0000) Subject: Synch to Gnus 200306232033. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9fb182b42b4881ec1fbf6249a0aacf33d127d1ae;p=elisp%2Fgnus.git- Synch to Gnus 200306232033. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5dccdae..a09c915 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2003-06-23 Teodor Zlatanov + + * spam.el (spam-from-listed-p, spam-parse-list): use + ietf-drums-parse-addresses to extract the address portion of the + whitelist/blacklist file if it looks like an address can be found + +2003-06-23 Didier Verna + + * gnus-ems.el (gnus-put-image): New argument CATEGORY. Add it as a + text property. + (gnus-remove-image): New argument CATEGORY. Only remove if + category matches. + * gnus-xmas.el (gnus-xmas-put-image): + (gnus-xmas-remove-image): Ditto, with extents. + * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to + gnus-[xmas-]remove-image. + (article-display-face): Don't always act as a toggle. Call + `gnus-put-image' with CATEGORY argument. + (article-display-x-face): Call `gnus-put-image' with CATEGORY + argument. + * smiley.el (smiley-region): Ditto. + * gnus-fun.el (gnus-display-x-face-in-from): Ditto. + * gnus-picon.el (gnus-picon-insert-glyph): Ditto. + (gnus-treat-mail-picon): Don't always act as a toggle. + * gnus-picon.el (gnus-treat-newsgroups-picon): Ditto. + +2003-06-23 Didier Verna + + * gnus-art.el (article-display-face): Check for existence of the + original article buffer before switching to it. + 2003-06-20 Jesper Harder * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by @@ -110,7 +141,7 @@ is requested but the message is not spam 2003-06-09 Teodor Zlatanov - From Eric + From Eric * spam.el (spam-use-spamoracle): new variable @@ -118,12 +149,12 @@ for activation of spam-install-hooks (spam-spamoracle): new variable customization group (spam-spamoracle, spam-spamoracle): new variables - (spam-group-spam-processor-spamoracle-p) + (spam-group-spam-processor-spamoracle-p) (spam-group-ham-processor-spamoracle-p): new functions (spam-summary-prepare-exit): added spamoracle ham/spam exit processing (spam-list-of-checks, spam-list-of-statistical-checks): add spam-use-spamoracle - (spam-check-spamoracle, spam-spamoracle-learn) + (spam-check-spamoracle, spam-spamoracle-learn) (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): new functions * gnus.el (gnus-group-spam-exit-processor-spamoracle) @@ -179,7 +210,7 @@ 2003-06-04 Lars Magne Ingebrigtsen * rfc2047.el (rfc2047-encode-region): Don't error out on invalid - strings. + strings. 2003-06-04 Jesper Harder @@ -285,7 +316,7 @@ 2003-05-28 Teodor Zlatanov * gnus-registry.el (gnus-registry-dirty): flag for modified registry - (gnus-registry-save, gnus-registry-read) + (gnus-registry-save, gnus-registry-read) (gnus-registry-store-extra, gnus-registry-clear): use it (note that gnus-registry-store-extra is invoked for all modifications to set the mtime, so gnus-registry-dirty only needs to be set there) @@ -326,7 +357,7 @@ * gnus-agent.el (gnus-agentize): Updated documentation to match usage. (gnus-agent-expire-group-1): Do not skip over a group when the - force argument is set. + force argument is set. * gnus.el (gnus-agent): Updated documentation to reflect that gnus-agent now defaults to t. @@ -340,31 +371,31 @@ 2003-05-14 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-delete-incoming): Changed to t. + * mail-source.el (mail-source-delete-incoming): Changed to t. * rfc2047.el (rfc2047-syntax-table): Funcall. - * lpath.el ((featurep 'xemacs)): Added set-char-table-range. + * lpath.el ((featurep 'xemacs)): Added set-char-table-range. ((featurep 'xemacs)): No, don't. - * rfc2047.el (rfc2047-encodable-p): Use the header charset. + * rfc2047.el (rfc2047-encodable-p): Use the header charset. * gnus-sum.el (gnus-summary-reselect-current-group): Supply - leave-hidden. + leave-hidden. 2003-05-14 Jonathan Kamens * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny - patch.) + patch.) 2003-05-13 Lars Magne Ingebrigtsen * gnus-registry.el (gnus-registry-store-extra-entry): Use - gnus-assq-delete-all. + gnus-assq-delete-all. * gnus-xmas.el (gnus-xmas-assq-delete-all): New function. - * message.el (message-ignored-bounced-headers): Add Delivered-To. + * message.el (message-ignored-bounced-headers): Add Delivered-To. * gnus-sum.el (gnus-summary-find-next): Indent. (gnus-summary-find-prev): Ditto. @@ -374,7 +405,7 @@ * gnus-util.el (gnus-user-date): Use %d instead of %m. (gnus-user-date): Use floating point time so that we don't get - overflows. + overflows. * gnus-sum.el (gnus-summary-local-variables): Clean up. @@ -400,8 +431,8 @@ 2003-05-12 Teodor Zlatanov * gnus-registry.el (gnus-registry-install): new variable - (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) - (gnus-registry-store-extra-entry, gnus-registry-delete-group) + (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) + (gnus-registry-store-extra-entry, gnus-registry-delete-group) (gnus-registry-add-group): add a modification timestamp to each entry (gnus-registry-install-hooks): new function @@ -418,14 +449,14 @@ references to each field's symbol. gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable. (gnus-select-newgroup): Initialize it. - (gnus-summary-highlight-line): Use it. + (gnus-summary-highlight-line): Use it. 2003-05-12 Dave Love * mm-util.el (mm-read-charset): Deleted. (mm-coding-system-mime-charset): New. - (mm-read-coding-system, mm-mule-charset-to-mime-charset) - (mm-charset-to-coding-system, mm-mime-charset) + (mm-read-coding-system, mm-mule-charset-to-mime-charset) + (mm-charset-to-coding-system, mm-mime-charset) (mm-find-mime-charset-region): Use it. (mm-default-multibyte-p): Fix non-mule case. @@ -443,7 +474,7 @@ 2003-05-11 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added - space. + space. 2003-05-11 Jesper Harder @@ -547,7 +578,7 @@ * message.el (message-setup-1): Setup alternative email before generate-headers. - + (message-forward-subject-name-subject): Fix the case when the field "from" doesn't exist. @@ -721,9 +752,9 @@ * gnus.el (gnus-install-group-spam-parameters): docstring fix. From Jon Ericson (tiny change) - * gnus-registry.el (gnus-registry-fetch-extra) + * gnus-registry.el (gnus-registry-fetch-extra) (gnus-registry-store-extra, gnus-registry-group-count): new functions - (gnus-registry-fetch-group, gnus-registry-delete-group) + (gnus-registry-fetch-group, gnus-registry-delete-group) (gnus-registry-add-group): changed to work with extra data element if present @@ -756,12 +787,12 @@ 2003-05-01 Lars Magne Ingebrigtsen - * spam-stat.el (spam-stat-test-directory): Compare against zero. + * spam-stat.el (spam-stat-test-directory): Compare against zero. 2003-05-01 Trey Jackson (tiny change) * spam-stat.el (spam-stat-test-directory): Skip 0 length files. - + 2003-05-01 Lars Magne Ingebrigtsen * message.el (message-forward-subject-name-subject): Decode @@ -809,7 +840,7 @@ 2003-05-01 Lars Magne Ingebrigtsen * message.el (message-check-news-header-syntax): Alter "posting" - message. + message. * nnrss.el (nnrss-node-text): Don't use char classes. @@ -911,7 +942,7 @@ (gnus-registry-add-group): new function (gnus-register-spool-action): use it (gnus-register-action): use it - (gnus-registry-translate-from-alist) + (gnus-registry-translate-from-alist) (gnus-registry-translate-to-alist): remove the headers registry for now @@ -981,8 +1012,8 @@ 2003-04-27 Reiner Steib - * gnus-art.el (gnus-mime-display-multipart-as-mixed) - (gnus-mime-display-multipart-alternative-as-mixed) + * gnus-art.el (gnus-mime-display-multipart-as-mixed) + (gnus-mime-display-multipart-alternative-as-mixed) (gnus-mime-display-multipart-related-as-mixed): Added doc-strings, allow customization. @@ -993,7 +1024,7 @@ 2003-04-27 Lars Magne Ingebrigtsen - * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. + * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. (gnus-summary-mark-read-and-unread-as-read): Take an optional mark. @@ -1013,13 +1044,13 @@ * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix. * nnrss.el (nnrss-node-text): Use only one - gnus-replace-in-string. + gnus-replace-in-string. * gnus.el: Remove gnus-functionp throughout. * gnus-util.el (gnus-functionp): Removed. - * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. + * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. * message.el (message-required-headers): Add In-Reply-To. @@ -1073,7 +1104,7 @@ systems property. * mml-sec.el (mml2015, mml1991): Don't require. - (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) + (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) (message-goto-body, mml-insert-tag): Autoload. * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings. @@ -1092,7 +1123,7 @@ 2003-04-24 Reiner Steib - * gnus-group.el (gnus-large-ephemeral-newsgroup) + * gnus-group.el (gnus-large-ephemeral-newsgroup) (gnus-fetch-old-ephemeral-headers): News variables. (gnus-group-read-ephemeral-group): Use them. @@ -1382,7 +1413,7 @@ * message.el (message-hide-headers): Don't do intangible. * gnus.el (gnus-group-prefixed-name): Comment out the test for - colon. + colon. * gnus-srvr.el (gnus-browse-read-group): Don't give the real name to the ephemeral entry, but the prefixed name. @@ -1411,7 +1442,7 @@ 2003-04-13 Lars Magne Ingebrigtsen - * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. + * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. 2003-04-12 Lars Magne Ingebrigtsen @@ -1422,7 +1453,7 @@ * message.el (message-newline-and-reformat): Place a boundary before filling. (message-make-forward-subject-function): Changed default to - message-forward-subject-name-subject. + message-forward-subject-name-subject. (message-forward-subject-name-subject): New function. * nnimap.el (nnimap-split-fancy): Ditto. @@ -1438,7 +1469,7 @@ (message-fix-before-sending): Make hidden headers visible. (message-hide-headers): Bind after-change-functions to nil. (message-forbidden-properties): Put invisible and intangible - back. + back. (message-strip-forbidden-properties): Ignore message-hidden text. * gnus-msg.el: Hide headers. @@ -1448,7 +1479,7 @@ (message-hide-header-p): New function. (message-hide-header-p): Change logic. (message-forbidden-properties): Remove intangible nil invisible - nil. + nil. (message-hide-headers): Narrow to headers. * lpath.el (featurep): Bind Info-directory, Info-menu. @@ -1587,7 +1618,7 @@ (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do. * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do. - + 2003-04-05 Teodor Zlatanov * spam.el (spam-split): (save-excursion) around (widen) @@ -1705,7 +1736,7 @@ nnheader-accept-process-output. (pop3-retr): Ditto. - * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. + * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. (mm-text-html-washer-alist): Ditto. 2003-03-31 Simon Josefsson @@ -1749,7 +1780,7 @@ 2003-03-30 Lars Magne Ingebrigtsen - * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. + * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. * gnus-registry.el (gnus-registry-translate-to-alist): Make a valid lambda. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 085e6fa..efc34cc 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -253,8 +253,8 @@ regexp. If it matches, the text in question is not a signature." :type 'sexp :group 'gnus-article-hiding) -;; Fixme: This isn't the right thing for mixed graphical and -;; non-graphical frames in a session. +;; Fixme: This isn't the right thing for mixed graphical and non-graphical +;; frames in a session. (defcustom gnus-article-x-face-command (cond (noninteractive @@ -2119,29 +2119,40 @@ unfolded." (defun article-display-face () "Display any Face headers in the header." (interactive) - (gnus-with-article-headers - (if (memq 'face gnus-article-wash-types) - (gnus-delete-images 'face) - (let (face faces) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (mail-narrow-to-head) - (while (gnus-article-goto-header "Face") - (push (mail-header-field-value) faces)))) - (while (setq face (pop faces)) - (let ((png (gnus-convert-face-to-png face)) - image) - (when png - (setq image (gnus-create-image png 'png t)) - (gnus-article-goto-header "from") - (when (bobp) - (insert "From: [no `from' set]\n") - (forward-char -17)) - (gnus-add-wash-type 'face) - (gnus-add-image 'face image) - (gnus-put-image image)))))) - )) + (let ((wash-face-p buffer-read-only)) + (gnus-with-article-headers + ;; When displaying parts, this function can be called several times on + ;; the same article, without any intended toggle semantic (as typing `W + ;; D d' would have). So face deletion must occur only when we come from + ;; an interactive command, that is when the *Article* buffer is + ;; read-only. + (if (and wash-face-p (memq 'face gnus-article-wash-types)) + (gnus-delete-images 'face) + (let (face faces) + (save-excursion + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward "^Face:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (while (gnus-article-goto-header "Face") + (push (mail-header-field-value) faces)))) + (while (setq face (pop faces)) + (let ((png (gnus-convert-face-to-png face)) + image) + (when png + (setq image (gnus-create-image png 'png t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image nil 'face)))))) + ))) (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." @@ -2151,7 +2162,8 @@ unfolded." ;; Delete the old process, if any. (when (process-status "article-x-face") (delete-process "article-x-face")) - (if (memq 'xface gnus-article-wash-types) + ;; See the comment in `article-display-face'. + (if (and wash-face-p (memq 'xface gnus-article-wash-types)) ;; We have already displayed X-Faces, so we remove them ;; instead. (gnus-delete-images 'xface) @@ -5232,7 +5244,7 @@ is the string to use when it is inactive.") "Delete all images in CATEGORY." (let ((entry (assq category gnus-article-image-alist))) (dolist (image (cdr entry)) - (gnus-remove-image image)) + (gnus-remove-image image category)) (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) (gnus-delete-wash-type category))) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 660e057..26906a0 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -233,16 +233,19 @@ (setq props (plist-put props :background (face-background face)))) (apply 'create-image file type data-p props))) -(defun gnus-put-image (glyph &optional string) +(defun gnus-put-image (glyph &optional string category) (insert-image glyph (or string " ")) + (put-text-property (1- (point)) (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point) 'gnus-image-text-deletable t)) glyph) -(defun gnus-remove-image (image) +(defun gnus-remove-image (image &optional category) (dolist (position (message-text-with-property 'display)) - (when (equal (get-text-property position 'display) image) + (when (and (equal (get-text-property position 'display) image) + (equal (get-text-property position 'gnus-image-category) + category)) (put-text-property position (1+ position) 'display nil) (when (get-text-property position 'gnus-image-text-deletable) (delete-region position (1+ position)))))) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index a174779..ca5cdea 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -192,7 +192,7 @@ colors of the displayed X-Faces." (concat "X-Face: " data) 'xface t :face 'gnus-x-face) (gnus-create-image - pbm 'pbm t :face 'gnus-x-face)))) + pbm 'pbm t :face 'gnus-x-face)) nil 'xface)) (gnus-add-wash-type 'xface)))))) (defun gnus-grab-cam-x-face () diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 8fed51f..ea506bd 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -141,7 +141,7 @@ GLYPH can be either a glyph or a string." (insert glyph) (gnus-add-wash-type category) (gnus-add-image category (car glyph)) - (gnus-put-image (car glyph) (cdr glyph)))) + (gnus-put-image (car glyph) (cdr glyph) category))) (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) @@ -233,37 +233,46 @@ GLYPH can be either a glyph or a string." ;;; Commands: +;; #### NOTE: the test for buffer-read-only is the same as in +;; article-display-[x-]face. See the comment up there. + ;;;###autoload (defun gnus-treat-from-picon () "Display picons in the From header. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'from-picon gnus-article-wash-types) - (gnus-delete-images 'from-picon) - (gnus-picon-transform-address "from" 'from-picon)))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) + (gnus-delete-images 'from-picon) + (gnus-picon-transform-address "from" 'from-picon))) + )) ;;;###autoload (defun gnus-treat-mail-picon () "Display picons in the Cc and To headers. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'mail-picon gnus-article-wash-types) - (gnus-delete-images 'mail-picon) - (gnus-picon-transform-address "cc" 'mail-picon) - (gnus-picon-transform-address "to" 'mail-picon)))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) + (gnus-delete-images 'mail-picon) + (gnus-picon-transform-address "cc" 'mail-picon) + (gnus-picon-transform-address "to" 'mail-picon))) + )) ;;;###autoload (defun gnus-treat-newsgroups-picon () "Display picons in the Newsgroups and Followup-To headers. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'newsgroups-picon gnus-article-wash-types) - (gnus-delete-images 'newsgroups-picon) - (gnus-picon-transform-newsgroups "newsgroups") - (gnus-picon-transform-newsgroups "followup-to")))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) + (gnus-delete-images 'newsgroups-picon) + (gnus-picon-transform-newsgroups "newsgroups") + (gnus-picon-transform-newsgroups "followup-to"))) + )) (provide 'gnus-picon) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 2139537..f5babab 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -911,7 +911,7 @@ XEmacs compatibility workaround." (set-glyph-face glyph face)) glyph)) -(defun gnus-xmas-put-image (glyph &optional string) +(defun gnus-xmas-put-image (glyph &optional string category) "Insert STRING, but display GLYPH. Warning: Don't insert text immediately after the image." (let ((begin (point)) @@ -922,21 +922,21 @@ Warning: Don't insert text immediately after the image." (insert string) (setq begin (1- begin))) (setq extent (make-extent begin (point))) - (set-extent-property extent 'gnus-image t) + (set-extent-property extent 'gnus-image category) (set-extent-property extent 'duplicable t) (if string (set-extent-property extent 'invisible t)) (set-extent-property extent 'end-glyph glyph)) glyph) -(defun gnus-xmas-remove-image (image) +(defun gnus-xmas-remove-image (image &optional category) (map-extents (lambda (ext unused) (when (equal (extent-end-glyph ext) image) (set-extent-property ext 'invisible nil) (set-extent-property ext 'end-glyph nil)) nil) - nil nil nil nil nil 'gnus-image)) + nil nil nil nil nil 'gnus-image category)) (defun gnus-xmas-completing-read (prompt table &optional predicate require-match history) diff --git a/lisp/smiley.el b/lisp/smiley.el index 0411264..896e456 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -195,7 +195,7 @@ A list of images is returned." (gnus-add-image 'smiley image) (put-text-property (point) (progn - (gnus-put-image image string) + (gnus-put-image image string 'smiley) (point)) 'smilified t))))) (put-text-property beg (or end (point-max)) 'smilified nil) diff --git a/lisp/spam.el b/lisp/spam.el index 32fcaf6..8f329dc 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -47,6 +47,10 @@ ;; for nnimap-split-download-body-default (eval-when-compile (require 'nnimap)) +;; autoload ietf-drums-parse-addresses +(eval-and-compile + (autoload 'ietf-drums-parse-addresses "ietf-drums")) + ;; autoload query-dig (eval-and-compile (autoload 'query-dig "dig")) @@ -995,20 +999,24 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (while (not (eobp)) (setq address (buffer-substring (point) (spam-point-at-eol))) (forward-line 1) - (unless (zerop (length address)) - (setq address (regexp-quote address)) - (while (string-match "\\\\\\*" address) - (setq address (replace-match ".*" t t address))) - (push address contents)))) + ;; insert the e-mail address if detected, otherwise the raw data + (let ((pure-address (car (ietf-drums-parse-addresses address)))) + (push (or pure-address address) contents)))) (nreverse contents)))) (defun spam-from-listed-p (cache) (let ((from (message-fetch-field "from")) found) (while cache - (when (string-match (pop cache) from) - (setq found t - cache nil))) + (let* ((address (pop cache))) + (unless (zerop (length address)) ; 0 for a nil address too + (setq address (regexp-quote address)) + ;; fix regexp-quote's treatment of user-intended regexes + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address)))) + (when (and address (string-match address from)) + (setq found t + cache nil)))) found)) (defun spam-blacklist-register-routine ()