forked from pool/xemacs
53 lines
2.2 KiB
Diff
53 lines
2.2 KiB
Diff
|
--- lisp/x-font-menu.el
|
||
|
|
+++ lisp/x-font-menu.el 2009-06-17 13:00:28.066568736 +0000
|
||
|
|
@@ -166,6 +166,17 @@ It must be set at run-time.")
|
||
|
|
(setcdr dev-cache data)
|
||
|
|
data))
|
||
|
|
|
||
|
|
+(defun vassoc-ignore-case (key valist)
|
||
|
|
+ "Search VALIST for a vector whose first element is equal to KEY,
|
||
|
|
+but ignores differences in case and text representation.
|
||
|
|
+See also `assoc-ignore-case'."
|
||
|
|
+ ;; by Stig@hackvan.com
|
||
|
|
+ (let (el)
|
||
|
|
+ (catch 'done
|
||
|
|
+ (while (setq el (pop valist))
|
||
|
|
+ (and (compare-strings key 0 nil (aref el 0) 0 nil t)
|
||
|
|
+ (throw 'done el))))))
|
||
|
|
+
|
||
|
|
(defun x-reset-device-font-menus-core (device &optional debug)
|
||
|
|
"Generates the `Font', `Size', and `Weight' submenus for the Options menu.
|
||
|
|
This is run the first time that a font-menu is needed for each device.
|
||
|
|
@@ -202,7 +213,7 @@ or if you change your font path, you can
|
||
|
|
(error "internal error"))
|
||
|
|
(setq monospaced-p (string= "m" (match-string 1 name)))
|
||
|
|
(unless (string-match x-fonts-menu-junk-families family)
|
||
|
|
- (setq entry (or (vassoc family cache)
|
||
|
|
+ (setq entry (or (vassoc-ignore-case family cache)
|
||
|
|
(car (setq cache
|
||
|
|
(cons (vector family nil nil t)
|
||
|
|
cache)))))
|
||
|
|
@@ -309,7 +320,7 @@ or if you change your font path, you can
|
||
|
|
(family (and pattern
|
||
|
|
(fc-pattern-get-family pattern 0))))
|
||
|
|
(if (fc-pattern-get-successp family)
|
||
|
|
- (setq entry (vassoc family (aref dcache 0))))
|
||
|
|
+ (setq entry (vassoc-ignore-case family (aref dcache 0))))
|
||
|
|
(if (null entry)
|
||
|
|
(make-vector 5 nil)
|
||
|
|
(let ((weight (fc-pattern-get-weight pattern 0))
|
||
|
|
@@ -338,11 +349,11 @@ or if you change your font path, you can
|
||
|
|
family size weight entry slant)
|
||
|
|
(when (string-match x-font-regexp-foundry-and-family name)
|
||
|
|
(setq family (capitalize (match-string 1 name)))
|
||
|
|
- (setq entry (vassoc family (aref dcache 0))))
|
||
|
|
+ (setq entry (vassoc-ignore-case family (aref dcache 0))))
|
||
|
|
(when (and (null entry)
|
||
|
|
(string-match x-font-regexp-foundry-and-family truename))
|
||
|
|
(setq family (capitalize (match-string 1 truename)))
|
||
|
|
- (setq entry (vassoc family (aref dcache 0))))
|
||
|
|
+ (setq entry (vassoc-ignore-case family (aref dcache 0))))
|
||
|
|
|
||
|
|
(if (null entry)
|
||
|
|
(make-vector 5 nil)
|