From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/53229 Path: main.gmane.org!not-for-mail From: Didier Verna Newsgroups: gmane.emacs.gnus.general Subject: [COMMIT] More image fixes Date: Mon, 23 Jun 2003 19:53:49 +0200 Sender: ding-owner@lists.math.uh.edu Message-ID: NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable X-Trace: main.gmane.org 1056390843 22155 80.91.224.249 (23 Jun 2003 17:54:03 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 23 Jun 2003 17:54:03 +0000 (UTC) Original-X-From: ding-owner+M1773@lists.math.uh.edu Mon Jun 23 19:53:58 2003 Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19UVVJ-0005i8-00 for ; Mon, 23 Jun 2003 19:53:21 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 19UVUu-0001tN-00; Mon, 23 Jun 2003 12:52:56 -0500 Original-Received: from sclp3.sclp.com ([64.157.176.121]) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 19UVUo-0001tI-00 for ding@lists.math.uh.edu; Mon, 23 Jun 2003 12:52:50 -0500 Original-Received: (qmail 16812 invoked by alias); 23 Jun 2003 17:52:50 -0000 Original-Received: (qmail 16807 invoked from network); 23 Jun 2003 17:52:49 -0000 Original-Received: from hermes.epita.fr (HELO epita.fr) (163.5.255.10) by sclp3.sclp.com with SMTP; 23 Jun 2003 17:52:49 -0000 Original-Received: from kualalumpur.lrde.epita.fr (kualalumpur.lrde.epita.fr [10.223.13.1]) by epita.fr id h5NHqhS07772 for EPITA Paris France Mon, 23 Jun 2003 19:52:43 +0200 (CEST) Original-Received: from debian.lrde.epita.fr ([10.223.13.53] helo=uzeb.lrde.epita.fr ident=mail) by kualalumpur.lrde.epita.fr with esmtp (Exim 3.35 #1 (Debian)) id 19UVVm-00010S-00 for ; Mon, 23 Jun 2003 19:53:50 +0200 Original-Received: from didier by uzeb.lrde.epita.fr with local (Exim 3.36 #1 (Debian)) id 19UVVl-0001VA-00 for ; Mon, 23 Jun 2003 19:53:49 +0200 Original-To: Gnus Beta Testers X-Attribution: drv X-Url: http://www.lrde.epita.fr/~didier X-Web: http://www.lrde.epita.fr/~didier X-Home-Page: http://www.lrde.epita.fr/~didier Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAAHlBMVEXw7ehubWUHBwRFPDAe FQ3ltJt1UDmVhHaWbVbMk3Zb3KlaAAACV0lEQVR4nF3UwXLbIBAA0Fw0Hh/ddKKcqX5AQaP4GsT0 7ByIzTFVBqvHThrbOjvG6ANkaf+2uyC5djjyBMsui25uhrFVOJbbMGaz2TA9ub3lfBYrBdcQZYJJ xmT6dcWzECxhjCWD/BnhbyIlrkB5vIZvRW5KKVCK+Ao2tXPOZCKRIh2ChNg7R8PKRCQ/4gvQOwDo ndszPNzjBXQNAiAIkYin2Aeh+ekWoCWxlE3yH5Y42SqSjMmErUeIag8aw5QC00njERqgAuKSrqS9 KBUfXOPnNDSCpCDpCBonPegyo/TzAdpWW+MweqveC4KnOJTkQ1tuqoZkkxVYS0yegk/mbX+kNHCv jZQiYcVrOJXBJWt/MNhjGX10v9Xdh/r86VB0X2Z0KSwPN3i3UKeqxxiqLzllKIsAuIetgPaC0hiH SZ5B++8xuFkr2JxhQdUIudvfqu0RXgmilr4N1bJN376zEfzUCI4gSQlUpPRQxd62B/hkIgDWbygv Xjscul8jTI5ncK45LAm4j2GacChNACvfdv64dg562Mkepntq4gC7Mtwt1AgnFi6RADsN/E6NK6s3 jIDACU6Va3wv1NZUWYCCYNX0ARyWkOqOl1ikHqitFHQI9oEeCVqO8GKgr7F3dsZUHujRcXqYDvrj FnbW5JUVF7Cqgd6HLXlFbU3B8RLpVB3YiubzqtvjCnxWYcVLvLWm5Lww7hqec244vlpeYfOyC5hK 7FiEuQP35mEIHn3HL2jB8QvgfyGRBbVvACpi4SHa4NXk964Gm/n/Q4BFtOScm9k9PlECEeAfFqlT cT2VapAAAAAASUVORK5CYII= X-Face: -*P;EgltV90C93(@dp99sIxwaZr;3.6[uaB4':cU$~i"y0Z%$1<4!eVHGnsFN9~zO/ykZq3 \2;1Re9}$0($XxRx=I.>5QZ%Ts+lW3d-S-R;[Q=%HiN,(WmExcBEBS*W;Y&xF"ePT\b^ Mail-Copies-To: never X-Generated-By: Patcher version 3.4.1 User-Agent: Gnus/5.1003 (Gnus v5.10.3) XEmacs/21.4 (Rational FORTRAN, linux) Precedence: bulk Xref: main.gmane.org gmane.emacs.gnus.general:53229 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:53229 NOTE: This patch has been committed. The version below is informational only (whitespace differences have been removed). Dear folks, The following patch fixes different bugs in image handling, especially one reported recently and one apparently unnoticed until now: images can be shared by different categories, but removing one category actually removed = all images instances, even those belonging to another category. One bug I just discovered is still there: with attached messages, everything is correctly displayed first, but after removing the images and requesting them again (WDd WDx etc), the ones in the attached message are not displayed anymore. lisp/ChangeLog addition: 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. Gnus source patch: Diff command: runsocks cvs -q diff -u -t -b -B -w Files affected: lisp/smiley.el lisp/gnus-picon.el lisp/gnus-fun.el lisp/gnu= s-xmas.el lisp/gnus-ems.el lisp/gnus-art.el Index: lisp/gnus-art.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/gnus-art.el,v retrieving revision 6.352 diff -u -u -t -b -B -w -r6.352 gnus-art.el --- lisp/gnus-art.el 23 Jun 2003 12:13:32 -0000 6.352 +++ lisp/gnus-art.el 23 Jun 2003 17:34:35 -0000 @@ -243,8 +243,8 @@ :type 'sexp :group 'gnus-article-hiding) -;; Fixme: This isn't the right thing for mixed graphical and 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 (if (featurep 'xemacs) (if (or (gnus-image-type-available-p 'xface) @@ -1976,12 +1976,22 @@ (defun article-display-face () "Display any Face headers in the header." (interactive) + (let ((wash-face-p buffer-read-only)) (gnus-with-article-headers - (if (memq 'face gnus-article-wash-types) + ;; 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 f= rom + ;; 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 - (and (gnus-buffer-live-p gnus-original-article-buffer) + (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) @@ -1998,8 +2008,8 @@ (forward-char -17)) (gnus-add-wash-type 'face) (gnus-add-image 'face image) - (gnus-put-image 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." @@ -2009,7 +2019,8 @@ ;; 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) @@ -4851,7 +4862,7 @@ "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))) Index: lisp/gnus-ems.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/gnus-ems.el,v retrieving revision 6.26 diff -u -u -t -b -B -w -r6.26 gnus-ems.el --- lisp/gnus-ems.el 2 May 2003 17:52:53 -0000 6.26 +++ lisp/gnus-ems.el 23 Jun 2003 17:34:35 -0000 @@ -219,16 +219,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)))))) Index: lisp/gnus-xmas.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/gnus-xmas.el,v retrieving revision 6.40 diff -u -u -t -b -B -w -r6.40 gnus-xmas.el --- lisp/gnus-xmas.el 2 Jun 2003 22:52:57 -0000 6.40 +++ lisp/gnus-xmas.el 23 Jun 2003 17:34:35 -0000 @@ -834,7 +834,7 @@ (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)) @@ -845,21 +845,21 @@ (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) Index: lisp/gnus-fun.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/gnus-fun.el,v retrieving revision 6.47 diff -u -u -t -b -B -w -r6.47 gnus-fun.el --- lisp/gnus-fun.el 13 May 2003 16:37:31 -0000 6.47 +++ lisp/gnus-fun.el 23 Jun 2003 17:34:35 -0000 @@ -192,7 +192,7 @@ (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 () Index: lisp/gnus-picon.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/gnus-picon.el,v retrieving revision 6.25 diff -u -u -t -b -B -w -r6.25 gnus-picon.el --- lisp/gnus-picon.el 8 May 2003 23:02:20 -0000 6.25 +++ lisp/gnus-picon.el 23 Jun 2003 17:34:35 -0000 @@ -139,7 +139,7 @@ (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)) @@ -231,37 +231,46 @@ ;;; 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) + (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (memq 'from-picon gnus-article-wash-types) + (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) (gnus-delete-images 'from-picon) - (gnus-picon-transform-address "from" '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) + (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (memq 'mail-picon gnus-article-wash-types) + (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)))) + (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) + (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (memq 'newsgroups-picon gnus-article-wash-types) + (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-type= s)) (gnus-delete-images 'newsgroups-picon) (gnus-picon-transform-newsgroups "newsgroups") - (gnus-picon-transform-newsgroups "followup-to")))) + (gnus-picon-transform-newsgroups "followup-to"))) + )) (provide 'gnus-picon) Index: lisp/smiley.el =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /usr/local/cvsroot/gnus/lisp/smiley.el,v retrieving revision 6.13 diff -u -u -t -b -B -w -r6.13 smiley.el --- lisp/smiley.el 26 Mar 2003 20:48:26 -0000 6.13 +++ lisp/smiley.el 23 Jun 2003 17:34:35 -0000 @@ -132,7 +132,7 @@ (push image images) (gnus-add-wash-type 'smiley) (gnus-add-image 'smiley image) - (gnus-put-image image string)))) + (gnus-put-image image string 'smiley)))) images)))) ;;;###autoload -- Didier Verna, didier@lrde.epita.fr, http://www.lrde.epita.fr/~didier EPITA / LRDE, 14-16 rue Voltaire Tel.+33 (1) 44 08 01 85 94276 Le Kremlin-Bic=EAtre, France Fax.+33 (1) 53 14 59 22 didier@xemac= s.org