File bnc502716-fontmenu.patch of Package xemacs.1580

Overview Repositories Revisions Requests Users Attributes Meta

File bnc502716-fontmenu.patch of Package xemacs.1580

--- 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)

Places

File bnc502716-fontmenu.patch of Package xemacs.1580

Places