[Emacs-diffs] emacs/lisp/term x-win.el

[Chong Yidong]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Chong Yidong <cyd>      08/11/29 06:52:31

Modified files:
        lisp/term      : x-win.el 

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

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/term/x-win.el?cvsroot=emacs&r1=1.236&r2=1.237

Patches:
Index: x-win.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/term/x-win.el,v
retrieving revision 1.236
retrieving revision 1.237
diff -u -b -r1.236 -r1.237
--- x-win.el    3 Nov 2008 17:57:33 -0000       1.236
+++ x-win.el    29 Nov 2008 06:52:31 -0000      1.237
@@ -1674,21 +1674,31 @@
                                       (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)
+  "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)
+                 (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)
+                 (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))))
-    nil))
+        x-gtk-stock-cache))))
 
 (provide 'x-win)