Mercurial > emacs
changeset 100024:3291f859ce65
(x-gtk-stock-cache): New hash table.
(x-gtk-map-stock): Perform caching to prevent excess consing during
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sat, 29 Nov 2008 06:52:31 +0000 |
| parents | 32c3e2f6272a |
| children | 4015958e8d9d |
| files | lisp/term/x-win.el |
| diffstat | 1 files changed, 24 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/term/x-win.el Sat Nov 29 06:51:18 2008 +0000 +++ b/lisp/term/x-win.el Sat Nov 29 06:52:31 2008 +0000 @@ -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) - (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)