mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-10 15:56:18 +00:00
Don't turn off compiler warnings in local vars.
Require ring when compiling. (gnus-x-splash): Bind width, height. (gnus-article-compface-xbm): New variable. (gnus-article-display-xface): Move graphic test. Use unibyte. Obey gnus-article-compface-xbm. Use pbm, not xbm.
This commit is contained in:
parent
ffc0e1caf1
commit
5f180e5360
@ -26,7 +26,9 @@
|
|||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(eval-when-compile (require 'cl))
|
(eval-when-compile
|
||||||
|
(require 'cl)
|
||||||
|
(require 'ring))
|
||||||
|
|
||||||
;;; Function aliases later to be redefined for XEmacs usage.
|
;;; Function aliases later to be redefined for XEmacs usage.
|
||||||
|
|
||||||
@ -162,7 +164,8 @@
|
|||||||
pixmap file height beg i)
|
pixmap file height beg i)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
|
(switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
|
||||||
(let ((buffer-read-only nil))
|
(let ((buffer-read-only nil)
|
||||||
|
width height)
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(when (and dir
|
(when (and dir
|
||||||
(file-exists-p (setq file
|
(file-exists-p (setq file
|
||||||
@ -197,12 +200,18 @@
|
|||||||
(defvar gnus-article-xface-ring-size 6
|
(defvar gnus-article-xface-ring-size 6
|
||||||
"Length of the ring used for `gnus-article-xface-ring-internal'.")
|
"Length of the ring used for `gnus-article-xface-ring-internal'.")
|
||||||
|
|
||||||
|
(defvar gnus-article-compface-xbm
|
||||||
|
(eq 0 (string-match "#define" (shell-command-to-string "uncompface -X")))
|
||||||
|
"Non-nil means the compface program supports the -X option.
|
||||||
|
That produces XBM output.")
|
||||||
|
|
||||||
(defun gnus-article-display-xface (beg end)
|
(defun gnus-article-display-xface (beg end)
|
||||||
"Display an XFace header from between BEG and END in the current article.
|
"Display an XFace header from between BEG and END in the current article.
|
||||||
Requires support for images in your Emacs and the external programs
|
Requires support for images in your Emacs and the external programs
|
||||||
`uncompface', and `icontopbm'. On a GNU/Linux system these
|
`uncompface', and `icontopbm'. On a GNU/Linux system these
|
||||||
might be in packages with names like `compface' or `faces-xface' and
|
might be in packages with names like `compface' or `faces-xface' and
|
||||||
`netpbm' or `libgr-progs', for instance.
|
`netpbm' or `libgr-progs', for instance. See also
|
||||||
|
`gnus-article-compface-xbm'.
|
||||||
|
|
||||||
This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
|
This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
|
||||||
for XEmacs."
|
for XEmacs."
|
||||||
@ -222,23 +231,35 @@ for XEmacs."
|
|||||||
(unless image
|
(unless image
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert data)
|
(insert data)
|
||||||
(and (eq 0 (call-process-region (point-min) (point-max)
|
(and (eq 0 (apply #'call-process-region (point-min) (point-max)
|
||||||
"uncompface"
|
"uncompface"
|
||||||
'delete '(t nil)))
|
'delete '(t nil) nil
|
||||||
(goto-char (point-min))
|
(if gnus-article-compface-xbm
|
||||||
(progn (insert "/* Width=48, Height=48 */\n") t)
|
'("-X"))))
|
||||||
(eq 0 (call-process-region (point-min) (point-max)
|
(if gnus-article-compface-xbm
|
||||||
"icontopbm"
|
t
|
||||||
'delete '(t nil)))
|
(goto-char (point-min))
|
||||||
|
(progn (insert "/* Width=48, Height=48 */\n") t)
|
||||||
|
(eq 0 (call-process-region (point-min) (point-max)
|
||||||
|
"icontopbm"
|
||||||
|
'delete '(t nil))))
|
||||||
;; Miles Bader says that faces don't look right as
|
;; Miles Bader says that faces don't look right as
|
||||||
;; light on dark.
|
;; light on dark.
|
||||||
(if (eq 'dark (cdr-safe (assq 'background-mode
|
(if (eq 'dark (cdr-safe (assq 'background-mode
|
||||||
(frame-parameters))))
|
(frame-parameters))))
|
||||||
(setq image (create-image (buffer-string) 'pbm t
|
(setq image (create-image (buffer-string)
|
||||||
|
(if gnus-article-compface-xbm
|
||||||
|
'xbm
|
||||||
|
'pbm)
|
||||||
|
t
|
||||||
:ascent 'center
|
:ascent 'center
|
||||||
:foreground "black"
|
:foreground "black"
|
||||||
:background "white"))
|
:background "white"))
|
||||||
(setq image (create-image (buffer-string) 'pbm t
|
(setq image (create-image (buffer-string)
|
||||||
|
(if gnus-article-compface-xbm
|
||||||
|
'xbm
|
||||||
|
'pbm)
|
||||||
|
t
|
||||||
:ascent 'center)))))
|
:ascent 'center)))))
|
||||||
(ring-insert gnus-article-xface-ring-internal (cons data image)))
|
(ring-insert gnus-article-xface-ring-internal (cons data image)))
|
||||||
(when image
|
(when image
|
||||||
@ -248,8 +269,4 @@ for XEmacs."
|
|||||||
|
|
||||||
(provide 'gnus-ems)
|
(provide 'gnus-ems)
|
||||||
|
|
||||||
;; Local Variables:
|
|
||||||
;; byte-compile-warnings: '(redefine callargs)
|
|
||||||
;; End:
|
|
||||||
|
|
||||||
;;; gnus-ems.el ends here
|
;;; gnus-ems.el ends here
|
||||||
|
Loading…
Reference in New Issue
Block a user