procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(x-gtk-stock-cache): New hash table.

Browse source 
(x-gtk-map-stock): Perform caching to prevent excess consing during
This commit is contained in:
Chong Yidong 2008-11-29 06:52:31 +00:00
parent f47b9de185
commit 2543eb396b
1 changed files with 24 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
lisp/term/x-win.el
View file

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