From 6be4a0560fe1e63c7b7fa0269fd568b583a1f345 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 11 Jun 1999 12:16:31 +0000 Subject: [PATCH] (language-info-alist): Defvar-maybe for old Emacsen. (current-language-environment): Ditto. (set-language-info): Defun-maybe for old Emacsen. (get-language-info): Ditto. (assoc-ignore-case): Ditto. --- lisp/gnus-ems.el | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 0e514bf..48afbf7 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -328,6 +328,49 @@ start (match-end 0))) (nreverse (cons (substring string start) parts))))) +(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)) + + +;;; 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))) + (provide 'gnus-ems) ;; Local Variables: -- 1.7.10.4