Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
2543eb39
Commit
2543eb39
authored
Nov 29, 2008
by
Chong Yidong
Browse files
(x-gtk-stock-cache): New hash table.
(x-gtk-map-stock): Perform caching to prevent excess consing during
parent
f47b9de1
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
24 additions
and
14 deletions
+24
-14
lisp/term/x-win.el
lisp/term/x-win.el
+24
-14
No files found.
lisp/term/x-win.el
View file @
2543eb39
...
...
@@ -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
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment