X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3f235d5d30e920586915fd621ce50b62f37ffdba..12dc447f2a94bd4523e088aec5fcc507afb8ead6:/lisp/term/x-win.el

diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index d0489844d7..c7f1aef803 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1,7 +1,7 @@
 ;;; x-win.el --- parse relevant switches and set up for X  -*-coding: iso-2022-7bit;-*-
 
 ;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: FSF
 ;; Keywords: terminals, i18n
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -2556,5 +2556,65 @@ order until succeed.")
 (and (fboundp 'menu-bar-open)
      (global-set-key [f10] 'x-menu-bar-open))
 
+(defcustom x-gtk-stock-map
+  '(
+    ("etc/images/new" . "gtk-new")
+    ("etc/images/open" . "gtk-open")
+    ("etc/images/diropen" . "n:system-file-manager")
+    ("etc/images/close" . "gtk-close")
+    ("etc/images/save" . "gtk-save")
+    ("etc/images/saveas" . "gtk-save-as")
+    ("etc/images/undo" . "gtk-undo")
+    ("etc/images/cut" . "gtk-cut")
+    ("etc/images/copy" . "gtk-copy")
+    ("etc/images/paste" . "gtk-paste")
+    ("etc/images/search" . "gtk-find")
+    ("etc/images/print" . "gtk-print")
+    ("etc/images/preferences" . "gtk-preferences")
+    ("etc/images/help" . "gtk-help")
+    ("etc/images/left-arrow" . "gtk-go-back")
+    ("etc/images/right-arrow" . "gtk-go-forward")
+    ("etc/images/home" . "gtk-home")
+    ("etc/images/jump-to" . "gtk-jump-to")
+    ("etc/images/index" . "gtk-index")
+    ("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.
+A value that begins with n: denotes a named icon instead of a stock icon."
+  :version "22.2"
+  :type 'alist
+  :group 'x)
+
+(defvar icon-map-list nil
+  "*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'."
+  (if (stringp file)
+      (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))
+
 ;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
 ;;; x-win.el ends here