# HG changeset patch # User Jan Dj¸«£rv # Date 1188751874 0 # Node ID c441663cac0953163f6088f0ab8619ebe489c017 # Parent 02e4d90b973f799a4fe4451c840f3e7b11d74669 (x-gtk-stock-map): Map diropen to system-file-manager. (icon-map-list): New variable. (x-gtk-map-stock): Use icon-map-list. diff -r 02e4d90b973f -r c441663cac09 lisp/term/x-win.el --- a/lisp/term/x-win.el Sun Sep 02 16:47:29 2007 +0000 +++ b/lisp/term/x-win.el Sun Sep 02 16:51:14 2007 +0000 @@ -2569,7 +2569,7 @@ '( ("etc/images/new" . "gtk-new") ("etc/images/open" . "gtk-open") - ("etc/images/diropen" . "gtk-directory") + ("etc/images/diropen" . "n:system-file-manager") ("etc/images/close" . "gtk-close") ("etc/images/save" . "gtk-save") ("etc/images/saveas" . "gtk-save-as") @@ -2589,17 +2589,37 @@ ("etc/images/search" . "gtk-find") ("etc/images/exit" . "gtk-quit")) "How icons for tool bars are mapped to Gtk+ stock items. -Emacs must be compiled with the Gtk+ toolkit for this to have any effect." +Emacs must be compiled with the Gtk+ toolkit for this to have any effect. +A value that begins with n: denotes a named icon instead of a stock icon." :version "23.1" :type 'alist :group 'x) +(defvar icon-map-list '(x-gtk-stock-map) + "*A list of alists that maps icon file names to stock/named icons. +The alists are searched in the order they appear. The first match is used. +The keys in the alists are file names without extension and with two directory +components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm +to stock item gtk-open, use: + + (\"etc/images/open\" . \"gtk-open\") + +Themes also have named icons. To map to one of those, use n: before the name: + + (\"etc/images/diropen\" . \"n:system-file-manager\") + +The list elements are either the symbol name for the alist or the alist itself.") + (defun x-gtk-map-stock (file) "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'." (let* ((file-sans (file-name-sans-extension file)) (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans) (match-string 1 file-sans))) - (value (assoc-string (or key file-sans) x-gtk-stock-map))) + (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)))) (provide 'x-win)