* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed.
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Wed, 2 Jan 2002 17:19:28 +0000 (17:19 +0000)
committerLars Magne Ingebrigtsen <larsi@gnus.org>
Wed, 2 Jan 2002 17:19:28 +0000 (17:19 +0000)
* gnus-art.el (gnus-ignored-headers): Hide all X-Faces.
(article-display-x-face): Display grey X-Faces.

lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-fun.el
lisp/gnus.el

index b29a998..ac9c98d 100644 (file)
@@ -1,5 +1,10 @@
 2002-01-02  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed.
+
+       * gnus-art.el (gnus-ignored-headers): Hide all X-Faces.
+       (article-display-x-face): Display grey X-Faces.
+
        * gnus-fun.el (gnus-convert-gray-x-face-region): New function.
        (gnus-convert-gray-x-face-to-ppm): Ditto.
        (gnus-convert-image-to-gray-x-face): Ditto.
index dd2a35d..fd122d7 100644 (file)
     "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
     "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
     "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
-    "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
+    "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face"
     "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
     "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
     "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
@@ -1791,43 +1791,49 @@ unfolded."
        ;; instead.
        (gnus-delete-images 'xface)
       ;; Display X-Faces.
-      (let (x-faces from face)
+      (let (x-faces from face grey)
        (save-excursion
          (set-buffer gnus-original-article-buffer)
          (save-restriction
            (mail-narrow-to-head)
-           (while (gnus-article-goto-header "x-face")
+           (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
+             (when (match-beginning 2)
+               (setq grey t))
              (push (mail-header-field-value) x-faces))
            (setq from (message-fetch-field "from"))))
-       ;; Sending multiple EOFs to xv doesn't work, so we only do a
-       ;; single external face.
-       (when (stringp gnus-article-x-face-command)
-         (setq x-faces (list (car x-faces))))
-       (while (and (setq face (pop x-faces))
-                   gnus-article-x-face-command
-                   (or force
-                       ;; Check whether this face is censored.
-                       (not gnus-article-x-face-too-ugly)
-                       (and gnus-article-x-face-too-ugly from
-                            (not (string-match gnus-article-x-face-too-ugly
-                                               from)))))
-         ;; We display the face.
-         (if (symbolp gnus-article-x-face-command)
-             ;; The command is a lisp function, so we call it.
-             (if (gnus-functionp gnus-article-x-face-command)
-                 (funcall gnus-article-x-face-command face)
-               (error "%s is not a function" gnus-article-x-face-command))
-           ;; The command is a string, so we interpret the command
-           ;; as a, well, command, and fork it off.
-           (let ((process-connection-type nil))
-             (process-kill-without-query
-              (start-process
-               "article-x-face" nil shell-file-name shell-command-switch
-               gnus-article-x-face-command))
-             (with-temp-buffer
-               (insert face)
-               (process-send-region "article-x-face" (point-min) (point-max)))
-             (process-send-eof "article-x-face"))))))))
+       (if grey
+           (gnus-put-image
+            (create-image (gnus-convert-gray-x-face-to-xpm x-faces) 'xpm t))
+         ;; Sending multiple EOFs to xv doesn't work, so we only do a
+         ;; single external face.
+         (when (stringp gnus-article-x-face-command)
+           (setq x-faces (list (car x-faces))))
+         (while (and (setq face (pop x-faces))
+                     gnus-article-x-face-command
+                     (or force
+                         ;; Check whether this face is censored.
+                         (not gnus-article-x-face-too-ugly)
+                         (and gnus-article-x-face-too-ugly from
+                              (not (string-match gnus-article-x-face-too-ugly
+                                                 from)))))
+           ;; We display the face.
+           (if (symbolp gnus-article-x-face-command)
+               ;; The command is a lisp function, so we call it.
+               (if (gnus-functionp gnus-article-x-face-command)
+                   (funcall gnus-article-x-face-command face)
+                 (error "%s is not a function" gnus-article-x-face-command))
+             ;; The command is a string, so we interpret the command
+             ;; as a, well, command, and fork it off.
+             (let ((process-connection-type nil))
+               (process-kill-without-query
+                (start-process
+                 "article-x-face" nil shell-file-name shell-command-switch
+                 gnus-article-x-face-command))
+               (with-temp-buffer
+                 (insert face)
+                 (process-send-region "article-x-face"
+                                      (point-min) (point-max)))
+               (process-send-eof "article-x-face")))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
index 76e8dbd..a8ca9ab 100644 (file)
@@ -97,7 +97,8 @@
                (nth i x-faces))))
     (delete-file mapfile)))
 
-(defun gnus-convert-gray-x-face-to-ppm (faces)
+;;;###autoload
+(defun gnus-convert-gray-x-face-to-xpm (faces)
   (let* ((depth (length faces))
         (scale (/ 255 (1- (expt 2 depth))))
         bit-list bit-lists pixels pixel)
       (insert "P2\n48 48\n255\n")
       (dolist (pixel pixels)
        (insert (number-to-string (* scale pixel)) " "))
+      (shell-command-on-region
+       (point-min) (point-max)
+       "ppmtoxpm"
+       (current-buffer) t (get-buffer-create " *junk"))
       (buffer-string))))
 
+;;;###autoload
 (defun gnus-convert-gray-x-face-region (beg end)
   "Convert the X-Faces in region to a PPM file."
   (interactive "r")
          (mail-header-narrow-to-field)
          (push (mail-header-field-value) faces)
          (goto-char (point-max)))))
-    (gnus-convert-gray-x-face-to-ppm faces)))
+    (gnus-convert-gray-x-face-to-xpm faces)))
 
 (provide 'gnus-fun)
 
index 0bfd168..f28018b 100644 (file)
@@ -1987,6 +1987,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-demon-remove-handler)
      ("gnus-demon" :interactive t
       gnus-demon-init gnus-demon-cancel)
+     ("gnus-fun" gnus-convert-gray-x-face-to-xpm)
      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
       gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close