+;;; Image functions.
+
+(defun gnus-image-type-available-p (type)
+ (and (fboundp 'image-type-available-p)
+ (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))))
+ (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)
+ (dolist (position (message-text-with-property 'display))
+ (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))))))
+
+(defun-maybe assoc-ignore-case (key alist)
+ "Like `assoc', but assumes KEY is a string and ignores case when comparing."
+ (setq key (downcase key))
+ (let (element)
+ (while (and alist (not element))
+ (if (equal key (downcase (car (car alist))))
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
+\f
+;;; Language support staffs.
+
+(defvar-maybe current-language-environment "English"
+ "The language environment.")
+
+(defvar-maybe language-info-alist nil
+ "Alist of language environment definitions.")
+
+(defun-maybe get-language-info (lang-env key)
+ "Return information listed under KEY for language environment LANG-ENV."
+ (if (symbolp lang-env)
+ (setq lang-env (symbol-name lang-env)))
+ (let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
+ (if lang-slot
+ (cdr (assq key (cdr lang-slot))))))
+
+(defun-maybe set-language-info (lang-env key info)
+ "Modify part of the definition of language environment LANG-ENV."
+ (if (symbolp lang-env)
+ (setq lang-env (symbol-name lang-env)))
+ (let (lang-slot key-slot)
+ (setq lang-slot (assoc lang-env language-info-alist))
+ (if (null lang-slot) ; If no slot for the language, add it.
+ (setq lang-slot (list lang-env)
+ language-info-alist (cons lang-slot language-info-alist)))
+ (setq key-slot (assq key lang-slot))
+ (if (null key-slot) ; If no slot for the key, add it.
+ (progn
+ (setq key-slot (list key))
+ (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
+ (setcdr key-slot info)))