(language-info-alist): Defvar-maybe for old Emacsen.
authoryamaoka <yamaoka>
Fri, 11 Jun 1999 12:16:31 +0000 (12:16 +0000)
committeryamaoka <yamaoka>
Fri, 11 Jun 1999 12:16:31 +0000 (12:16 +0000)
(current-language-environment): Ditto.
(set-language-info): Defun-maybe for old Emacsen.
(get-language-info): Ditto.
(assoc-ignore-case): Ditto.

lisp/gnus-ems.el

index 0e514bf..48afbf7 100644 (file)
              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))
+
+\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)))
+
 (provide 'gnus-ems)
 
 ;; Local Variables: