Mercurial > emacs
comparison lisp/gnus/gnus-ems.el @ 31802:c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Rationalize logic somewhat.
| author | Dave Love <fx@gnu.org> |
|---|---|
| date | Thu, 21 Sep 2000 09:23:32 +0000 |
| parents | d2b5643aab16 |
| children | 6d8322cfbf71 |
comparison
equal
deleted
inserted
replaced
| 31801:9de0c3880281 | 31802:c182c9b42c86 |
|---|---|
| 206 | 206 |
| 207 This function is for Emacs 21+. See `gnus-xmas-article-display-xface' | 207 This function is for Emacs 21+. See `gnus-xmas-article-display-xface' |
| 208 for XEmacs." | 208 for XEmacs." |
| 209 ;; It might be worth converting uncompface's output in Lisp. | 209 ;; It might be worth converting uncompface's output in Lisp. |
| 210 | 210 |
| 211 (unless gnus-article-xface-ring-internal ; Only load ring when needed. | 211 (when (if (fboundp 'display-graphic-p) |
| 212 (setq gnus-article-xface-ring-internal | 212 (display-graphic-p)) |
| 213 (make-ring gnus-article-xface-ring-size))) | 213 (unless gnus-article-xface-ring-internal ; Only load ring when needed. |
| 214 (save-excursion | 214 (setq gnus-article-xface-ring-internal |
| 215 (let* ((cur (current-buffer)) | 215 (make-ring gnus-article-xface-ring-size))) |
| 216 (data (buffer-substring beg end)) | 216 (save-excursion |
| 217 (image (cdr-safe (assoc data (ring-elements | 217 (let* ((cur (current-buffer)) |
| 218 gnus-article-xface-ring-internal))))) | 218 (data (buffer-substring beg end)) |
| 219 (when (if (fboundp 'display-graphic-p) | 219 (image (cdr-safe (assoc data (ring-elements |
| 220 (display-graphic-p)) | 220 gnus-article-xface-ring-internal)))) |
| 221 default-enable-multibyte-characters) | |
| 221 (unless image | 222 (unless image |
| 222 (let ((coding-system-for-read 'binary) | 223 (with-temp-buffer |
| 223 (coding-system-for-write 'binary)) | 224 (insert data) |
| 224 (with-temp-buffer | 225 (and (eq 0 (call-process-region (point-min) (point-max) |
| 225 (insert data) | 226 "uncompface" |
| 226 (and (eq 0 (call-process-region (point-min) (point-max) | 227 'delete '(t nil))) |
| 227 "uncompface" | 228 (goto-char (point-min)) |
| 228 'delete '(t nil))) | 229 (progn (insert "/* Width=48, Height=48 */\n") t) |
| 229 (goto-char (point-min)) | 230 (eq 0 (call-process-region (point-min) (point-max) |
| 230 (progn (insert "/* Width=48, Height=48 */\n") t) | 231 "icontopbm" |
| 231 (eq 0 (call-process-region (point-min) (point-max) | 232 'delete '(t nil))) |
| 232 "icontopbm" | 233 ;; Miles Bader says that faces don't look right as |
| 233 'delete '(t nil))) | 234 ;; light on dark. |
| 234 ;; Miles Bader says that faces don't look right as | 235 (if (eq 'dark (cdr-safe (assq 'background-mode |
| 235 ;; light on dark. | 236 (frame-parameters)))) |
| 236 (if (eq 'dark (cdr-safe (assq 'background-mode | |
| 237 (frame-parameters)))) | |
| 238 (setq image (create-image (buffer-string) 'pbm t | |
| 239 :ascent 'center | |
| 240 :foreground "black" | |
| 241 :background "white")) | |
| 242 (setq image (create-image (buffer-string) 'pbm t | 237 (setq image (create-image (buffer-string) 'pbm t |
| 243 :ascent 'center)))))) | 238 :ascent 'center |
| 244 (ring-insert gnus-article-xface-ring-internal (cons data image)))) | 239 :foreground "black" |
| 245 (when image | 240 :background "white")) |
| 246 (goto-char (point-min)) | 241 (setq image (create-image (buffer-string) 'pbm t |
| 247 (re-search-forward "^From:" nil 'move) | 242 :ascent 'center))))) |
| 248 (insert-image image))))) | 243 (ring-insert gnus-article-xface-ring-internal (cons data image))) |
| 244 (when image | |
| 245 (goto-char (point-min)) | |
| 246 (re-search-forward "^From:" nil 'move) | |
| 247 (insert-image image)))))) | |
| 249 | 248 |
| 250 (provide 'gnus-ems) | 249 (provide 'gnus-ems) |
| 251 | 250 |
| 252 ;; Local Variables: | 251 ;; Local Variables: |
| 253 ;; byte-compile-warnings: '(redefine callargs) | 252 ;; byte-compile-warnings: '(redefine callargs) |