diff options
| author | Lars Ingebrigtsen <larsi@gnus.org> | 2016-02-10 10:49:20 +1100 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2016-02-10 11:01:03 +1100 |
| commit | 34662c20bc0f0d6cc40af99ab830a80bc4952258 (patch) | |
| tree | e489bfc701dd5b22fab972db71571e28c4b62107 /lisp/gnus/gnus-util.el | |
| parent | 812cddf3060322cc5c59b2864b206e8ddc04e6fe (diff) | |
| download | emacs-34662c20bc0f0d6cc40af99ab830a80bc4952258.tar.gz | |
Move non-compat Gnus functions to gnus-util.el
* lisp/gnus/gnus-util.el (gnus-remove-image, gnus-put-image)
(gnus-create-image, gnus-image-type-available-p): Move here
from gnus-ems.el, since these aren't compat functions.
Diffstat (limited to 'lisp/gnus/gnus-util.el')
| -rw-r--r-- | lisp/gnus/gnus-util.el | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 31645fcd315..33d96bd20eb 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -2021,6 +2021,54 @@ lists of strings." (gnus-setdiff (cdr list1) list2) (cons (car list1) (gnus-setdiff (cdr list1) list2))))) +;;; Image functions. + +(defun gnus-image-type-available-p (type) + (and (fboundp 'image-type-available-p) + (if (fboundp 'display-images-p) + (display-images-p) + t) + (image-type-available-p type))) + +(defun gnus-create-image (file &optional type data-p &rest props) + (let ((face (plist-get props :face))) + (when face + (setq props (plist-put props :foreground (face-foreground face))) + (setq props (plist-put props :background (face-background face)))) + (ignore-errors + (apply 'create-image file type data-p props)))) + +(defun gnus-put-image (glyph &optional string category) + (let ((point (point))) + (insert-image glyph (or string " ")) + (put-text-property 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 &optional category) + "Remove the image matching IMAGE and CATEGORY found first." + (let ((start (point-min)) + val end) + (while (and (not end) + (or (setq val (get-text-property start 'display)) + (and (setq start + (next-single-property-change start 'display)) + (setq val (get-text-property start 'display))))) + (setq end (or (next-single-property-change start 'display) + (point-max))) + (if (and (equal val image) + (equal (get-text-property start 'gnus-image-category) + category)) + (progn + (put-text-property start end 'display nil) + (when (get-text-property start 'gnus-image-text-deletable) + (delete-region start end))) + (unless (= end (point-max)) + (setq start end + end nil)))))) + (provide 'gnus-util) ;;; gnus-util.el ends here |