From: Chong Yidong <cyd@stupidchicken.com>
Date: Sat, 29 Nov 2008 06:52:31 +0000 (+0000)
Subject: (x-gtk-stock-cache): New hash table.
X-Git-Tag: emacs-pretest-23.0.90~1448
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2543eb396b7c5b2754ed10c46e333e144c1967ce;p=emacs.git

(x-gtk-stock-cache): New hash table.
(x-gtk-map-stock): Perform caching to prevent excess consing during
---

diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index dc491704249..694e51c6a17 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1674,21 +1674,31 @@ If you don't want stock icons, set the variable to nil."
 				       (string :tag "Stock/named")))))
   :group 'x)
 
+(defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal))
+
 (defun x-gtk-map-stock (file)
-  "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
-  (if (stringp file)
-      (save-match-data
-	(let* ((file-sans (file-name-sans-extension file))
-	       (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
-			 (match-string 1 file-sans)))
-	       (value))
-	  (mapc (lambda (elem)
-		  (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
-		    (or value (setq value (assoc-string (or key file-sans)
-							assoc)))))
-		icon-map-list)
-	  (and value (cdr value))))
-    nil))
+  "Map icon with file name FILE to a Gtk+ stock name.
+This uses `icon-map-list' to map icon file names to stock icon names."
+  (when (stringp file)
+    (or (gethash file x-gtk-stock-cache)
+	(puthash
+	 file
+	 (save-match-data
+	   (let* ((file-sans (file-name-sans-extension file))
+		  (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)"
+					  file-sans)
+			    (match-string 1 file-sans)))
+		  (icon-map icon-map-list)
+		  elem value)
+	     (while (and (null value) icon-map)
+	       (setq elem (car icon-map)
+		     value (assoc-string (or key file-sans)
+					 (if (symbolp elem)
+					     (symbol-value elem)
+					   elem))
+		     icon-map (cdr icon-map)))
+	     (and value (cdr value))))
+	 x-gtk-stock-cache))))
 
 (provide 'x-win)