Commits

Anonymous committed a90bef9

Added icon-themes.el and buffer-colors.el

Comments (0)

Files changed (5)

+2012-01-06  Steve Mitchell   <smitchel@bnin.net> 
+	    Byrel Mitchell   <byrel.mitchell@gmail.com>
+         
+	* buffer-colors.el : created buffer-colors.el
+	Allows easy changing of foreground/background colors
+        via customize buffer, menu, and rule based changing.  
+
 2011-05-11  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 2.44 released.
 	reportmail.elc resume.elc rsz-minibuf.elc saveconf.elc savehist.elc \
 	saveplace.elc scroll-in-place.elc shell-font.elc tempo.elc \
 	toolbar-utils.elc tree-menu.elc uniquify.elc where-was-i-db.elc \
-	winring.elc vertical-mode.elc power-macros.elc \
+	winring.elc vertical-mode.elc power-macros.elc icon-themes.elc \
 	search-buffers.elc setnu.elc align.elc autorevert.elc allout.elc \
-	narrow-stack.elc highline.elc crm.elc wide-edit.elc
+	narrow-stack.elc highline.elc crm.elc wide-edit.elc buffer-colors.elc
 
 EXPLICIT_DOCS = $(PACKAGE).texi tempo.texi
 
+;;; buffer-colors.el
+;;; Copyright (C) 2011  Byrel Mitchell and Steve Mitchell
+;;; email: smitchel@bnin.net
+;;; email: byrel.mitchell@gmail.com
+;;;
+;;;  This program 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 3, or (at your option)
+;;;  any later version.
+;;;
+;;;  This program is distributed in the hope that it will be useful,
+;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;  GNU General Public License for more details.
+;;;
+;;;  You should have received a copy of the GNU General Public License
+;;;  along with this program; if not, write to the Free Software
+;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; 
+;;; Description:
+;;;
+;;;	A menu system for setting buffer local face colors.
+;;;     Allows adding and removing menu entries, and storage of permanent custom colors.
+;;; 
+;;;    Afer the first time it runs, on startup, it loads a list of colors from custom.el. 
+;;;    if none found, it creates a list of a few colors to start out with.  Thereafter 
+;;;    we keep a list in custom.el of all fg/bg pairs and load that list each time. 
+;;;
+;;;    These color changes are by default "by the buffer" (no matter the window or pane it is
+;;;    displayed in). It can also be set so the color changes will follow a window 
+;;;    (no matter what buffer is displayed there)
+;;;    Easy to choose between these 2 methods either on the menu or in a customize buffer:
+;;;      M-x customize-group buffer-colors       
+;;; 
+;;;    There is also a list of "rules" to colorize new buffers, based on things we can know
+;;;    about the file, such as read-only, or filename extension, or date-modified, etc. 
+;;;
+;;; Purpose is to have an easy at-hand way to change buffer colors 
+;;;  instead of a full customize buffer, making it easy to:
+;;;  -ease eye strain--change hourly, daily or as lighting conditions change.
+;;;  -On a 30" monitor I often have 3-4 buffers open and this helps me keep 
+;;;     straight which file is which--especially when source code and file names
+;;;     are very, very similar between files.
+;;;  -organize buffers by catagory:  
+;;;              have one fg/bg color pair for files that you load for referance
+;;;              have a fg/bg color you use for read only files
+;;;              have a fg/bg color you use for your try-out buffer 
+;;;              have a fr/bg color for open emails, another pair for replies
+;;;           Four example "rules" are pre-programmed in, you can remove or reorder 
+;;;           these, or add new rules.  Anything you know about a file can be used
+;;;           to create a "rule" to decide how to colorize files when loading them.
+;;;           (after they are loaded, and colorized then, you can still change the 
+;;;           colors at any time through either the Buffer Colors menu or 
+;;;           through a customize buffer (under the Buffer Colors menu-->settings).
+;;;
+;;; Adds a toggle turn buffer colors on/off:  Options-->Display-->Buffer Colors
+;;; Adds a selection to the Buffers Menu: Buffer Colors.
+;;; What it does:
+;;;     1.  Lets you specify foreground and background colors 
+;;;           differently for each buffer on the fly.
+;;;     2.  Lets you set new combinations of fg/bg colors 
+;;;           and save the list of colors to disk.
+;;;     3.  Displays a list in a buffer of valid colors 
+;;;           with their names, for you to refer to.
+;;;     3.  Creates a file buffercolors.el in your ~/.xemacs directory, 
+;;;          for storing fg/bg colors for the predefined choices on the menu.  
+;;;    4.  All code is in the file buffer-color-menu.el, 
+;;;         All settings are saved in custom.el
+;;;
+;;; TODO
+;;;   This implements buffer-colors as a behavior. Currently it needs enabled each session,
+;;;   by toggling Options-->Display-->Buffer-Colors 
+;;;     We need to find a way to have it on by default.
+;;;
+
+(require 'wid-edit) ;contains widget-value
+
+(define-specifier-tag 'buffer-colors)
+
+(define-specifier-tag 'bc-read-only)
+
+(defvar bc-fgbg-menu nil "Menu for Buffer Colors")
+
+
+;; the behaviour lets us 
+;;      disable Buffer Colors, 
+;;      remove the Buffer Colors menu item,
+;;      and delete all previously set buffer colors,
+;;         restoring them to the colors in the default face.  
+(define-behavior 'buffer-colors
+  "A system for quickly changing the fg and bg colors of buffers.
+It includes a rule-based system for coloring new buffers."
+  :enable 'bc-enable-behavior
+  :disable 'bc-disable-behavior)
+
+;;---- functions for rules ----------------------------------------
+(defun bc-read-only-p ()
+  "Return t if current buffer is read only."
+  buffer-read-only)
+
+(defun bc-c-file-p ()
+  "Return t if buffer file name ends in .c or .cpp."
+  (string-match "\\.c\\(pp\\)?$" buffer-file-name))
+
+(defun bc-h-file-p ()
+  "Return t if buffer file name ends in .h."
+  (string-match "\\.h$" buffer-file-name))
+
+(defun bc-el-file-p ()
+  "Return t if buffer file name ends in .el."
+  (string-match "\\.el$" buffer-file-name))
+
+(defmacro bc-set-fgbg (fg bg tag-set)
+  "Sets the fg/bg properties of the default face for the current buffer locale."
+  `(progn 
+    (set-face-foreground 'default ,fg 
+			 (if bc-per-window-flag 
+			     (selected-window) 
+			   (current-buffer)) ,tag-set) 
+    (set-face-background 'default ,bg 
+			 (if bc-per-window-flag 
+			     (selected-window) 
+			   (current-buffer)) ,tag-set)))
+  
+
+(defun bc-set-buffer-fgbg (fg bg tag-set)
+  "Sets the colors of the current buffer to `FG'/`BG'.
+This specifier will be associated with `TAG-SET'.
+For the more general function, see `bc-set-fgbg'"
+  (let ((bc-per-window-flag nil))
+    (bc-set-fgbg fg bg tag-set)))
+
+
+(defmacro bc-equal-fgbg-p (fg bg)
+  "Checks if new `FG'/`BG' are same as current fg/bg."
+  `(and (equal ,fg (color-instance-name (face-foreground-instance 'default)))
+    (equal ,bg (color-instance-name (face-background-instance 'default)))))
+
+
+(defun bc-add-fgbg-combination (&optional fg bg)
+  "Adds a foreground/background pair to Buffer Colors menu.
+And applies this selection to current buffer.."
+  (when (not fg)
+    (setq fg (facemenu-read-color "Foreground Color Name? :")))
+  (when (not bg)
+    (setq bg (facemenu-read-color "Background Color Name? :")))
+  (setq bc-buffer-color-combos (append bc-buffer-color-combos 
+				       (list (cons (downcase fg) 
+						   (downcase bg)))))
+  (bc-refresh-buffer-color-menu)
+  (bc-set-fgbg fg bg 'buffer-colors))
+
+
+(defun bc-delete-fgbg (fg bg)
+  "Removes an entry from buffer colors menu."
+  (delete (cons fg bg) bc-buffer-color-combos)
+  (bc-refresh-buffer-color-menu))
+
+;;;###autoload
+(defun bc-refresh-buffer-color-menu ()
+  "Refreshes buffer color menu from buffer-color-combos."
+  (setq bc-fgbg-menu `("Buffer Colors"
+		       ,@(bc-generate-select-menu)
+		       ("Settings"
+			["Use Windows Instead of Buffers"
+			 (if bc-per-window-flag
+			     (setq bc-per-window-flag nil)
+			   (setq bc-per-window-flag t))
+			 :style toggle 
+			 :selected bc-per-window-flag]
+			["New Colors On Bottom Of List"
+			 (progn
+			   (if bc-new-colors-at-bottom-flag
+			       (setq bc-new-colors-at-bottom-flag nil)
+			     (setq bc-new-colors-at-bottom-flag t))
+			   (bc-refresh-buffer-color-menu))
+			 :style toggle 
+			 :selected bc-new-colors-at-bottom-flag]
+			["Customize Buffer Colors..."
+			 (customize-group 'buffer-colors)])
+		       ("Custom Buffer Colors"
+			["Show all colors..." list-colors-display]
+			["Define Custom FG/BG" (bc-add-fgbg-combination)]
+			["Store current list" (bc-write-current-fgbg)]
+			("Delete colors from list" 
+			 ,@(bc-generate-delete-menu)))
+		       ["Reset Buffer to Defaults" (bc-clear-current-fgbg)]
+		       ["Reset All to Defaults" (bc-clear-all-fgbg)]))
+  (add-submenu '("Buffers") bc-fgbg-menu "List All Buffers"))
+
+
+(defun bc-clear-current-fgbg ()
+  "Removes any buffer color specification from the current buffer."
+  (remove-specifier (face-foreground 'default) (current-buffer) 'buffer-colors)
+  (remove-specifier (face-background 'default) (current-buffer) 'buffer-colors)
+  (remove-specifier (face-foreground 'default) (selected-window) 'buffer-colors)
+  (remove-specifier (face-background 'default) (selected-window) 'buffer-colors))
+
+
+(defun bc-clear-all-fgbg ()
+  "Removes all buffer color specifications from all buffers."
+  (loop for buffer being each buffer
+    do
+    (remove-specifier (face-foreground 'default) buffer 'buffer-colors)
+    (remove-specifier (face-background 'default) buffer 'buffer-colors))
+  (loop for window being each window
+    do
+    (remove-specifier (face-foreground 'default) window 'buffer-colors)
+    (remove-specifier (face-background 'default) window 'buffer-colors)))
+
+;;;###autoload
+(defun bc-enable-behavior ()
+  "Enables Buffer Color package
+By Default, this is done at load time."
+  (add-hook 'after-save-hook 'bc-remove-read-only-tags)
+  (add-hook 'find-file-hooks 'bc-evaluate-color-tests)
+  (bc-refresh-buffer-color-menu)
+  (add-menu-button '("Buffers") "---" "List All Buffers"))
+
+
+;;;###autoload
+(defun bc-disable-behavior ()
+  "Disables Buffer Color package.
+This removes the Buffer Color control menu and all currently colored buffers."
+  (bc-clear-all-fgbg)
+  (delete-menu-item '("Buffers" "Buffer Colors"))
+  (delete-menu-item '("Buffers" "---"))
+  (remove-hook 'after-save-hook 'bc-remove-read-only-tags)
+  (remove-hook 'find-file-hooks 'bc-evaluate-color-tests))
+
+;;;###autoload
+(defun bc-toggle-behavior ()
+  (interactive)
+  (if (behavior-enabled-p 'buffer-colors)
+      (disable-behavior 'buffer-colors)
+    (enable-behavior 'buffer-colors)))
+
+(defun bc-write-current-fgbg ()
+  "Writes buffer colors menu to file"
+  (custom-save-all))
+
+(defun bc-generate-select-menu ()
+  "Returns a list of fg/bg entries for buffer color menu"
+  (let ((temp (if bc-new-colors-at-bottom-flag 
+		  (reverse bc-buffer-color-combos) 
+		bc-buffer-color-combos))
+	(menu-list nil))
+    (while temp
+      (let ((fg (caar temp))
+	    (bg (cdar temp)))
+	(setq menu-list 
+	      (cons `[,(concat (capitalize fg) " on " (capitalize bg)) 
+		      (bc-set-fgbg ,fg ,bg 'buffer-colors) 
+		      :style radio 
+		      :selected (bc-equal-fgbg-p ,fg ,bg)] menu-list))
+	(setq temp (cdr temp))))
+    menu-list))
+
+(defun bc-generate-delete-menu ()
+  "Returns a list of fg/bg entries for delete buffer color menu"
+  (let ((temp (if bc-new-colors-at-bottom-flag 
+		  (reverse bc-buffer-color-combos) bc-buffer-color-combos))
+	(menu-list nil))
+    (while temp
+      (let ((fg (caar temp))
+	    (bg (cdar temp)))
+	(setq menu-list 
+	      (cons `[
+		      ,(concat "Delete " (capitalize fg) " on " (capitalize bg)) 
+		      (bc-delete-fgbg ,fg ,bg) ] 
+		    menu-list))
+	(setq temp (cdr temp))))
+    menu-list))
+
+(defun bc-remove-read-only-tags ()
+  (remove-specifier (face-foreground 'default) (current-buffer) 'bc-read-only)
+  (remove-specifier (face-background 'default) (current-buffer) 'bc-read-only))
+
+(defun bc-evaluate-color-tests ()
+  "Evaluates color tests to find the initial colors for a new buffer."
+  (loop for (enabledp predicate fg bg tag-set) in bc-file-color-tests
+    do
+    (when (and enabledp (funcall predicate))
+      (when tag-set
+	(unless (listp tag-set)
+	  (setq tag-set (list tag-set))))
+      (bc-set-buffer-fgbg fg bg (cons 'buffer-colors tag-set)))))
+
+
+
+
+;;;;---  create a customization group and variables for a customize buffer ---
+;;;###autoload
+(defgroup buffer-colors nil
+  "A system for easily modifying default foreground and backgrounds of buffers.")
+
+
+;; define new widget so in a customize buffer we can validate a user-input color name.
+;; validates both string names and rgb Hex codes for colors.
+;;;###autoload
+(define-widget 'color 'string
+  "A widget for entering displayable color names.
+Accepts either names or direct hex-codes (#rrggbb or #rrrrggggbbbb)."
+  :validate (lambda (widget)
+	      (if (or (string-match "^#[0-9a-f]\\{6,6\\}\\([0-9a-f]\\{6,6\\}\\)?$" (widget-value widget))
+		      (member (widget-value widget) (color-list)))
+		  nil
+		(widget-put widget :error (concat (widget-value widget) " is not a valid color name."))))
+		
+  :tag "Color"
+  :prompt-value (lambda (widget prompt value unbound)
+		  (read-color prompt nil (unless unbound value))))
+
+;; this variable controls whether the buffer colors follow windows or buffers.
+;; if the colors follow by buffer, the buffer contents stay that color no matter which
+;; windows the buffer is displayed in.
+;; if the colors follow the window, then the window will stay those colors no matter
+;; which buffer is displayed in that window. 
+;;;###autoload
+(defcustom bc-per-window-flag nil
+  "Scope of color assignments. Colors can follow current window or current buffer."
+  :tag "Buffer color scope"
+  :group 'buffer-colors
+  :initialize 'custom-initialize-default
+  :set (lambda (symbol value)
+	 (set-default symbol value)
+	 (bc-refresh-buffer-color-menu))
+  :type '(choice :tag "Colors follow"
+	  (const :tag "Buffer" nil)
+	  (const :tag "Window" t)))
+
+
+;; by default, additional color pairs are put in the top of the menu list.
+;; this variable adds additional color pairs at the bottom of the menu list instead.
+;;;###autoload
+(defcustom bc-new-colors-at-bottom-flag nil
+  "Sorting direction for Buffer Colors menu"
+  :tag "Buffer Colors menu sort direction"
+  :group 'buffer-colors
+  :initialize 'custom-initialize-default
+  :set (lambda (symbol value)
+	 (set-default symbol value)
+	 (bc-refresh-buffer-color-menu))
+  :type '(choice :tag "Buffer Colors menu is sorted from"
+	  (const :tag "Newest to Oldest" nil)
+	  (const :tag "Oldest to Newest" t)))
+
+
+
+;; list of a few foreground/background color pairs to start out with.
+;; usually only used the first time the program is run.
+;; as soon as some fg/bg pairs are defined and saved in custom.el,
+;; they are loaded instead of these.
+;;;###autoload
+(defcustom bc-buffer-color-combos '(("black" . "white")
+				    ("white" . "black")
+				    ("green" . "black")
+				    ("yellow" . "black")
+				    ("lightgoldenrod" . "sandybrown")
+				    ("orchid" . "mediumvioletred")
+				    ("deepskyblue" . "saddlebrowwn")
+				    ("yellowgreen" . "darkslategrey")
+				    ("slateblue" . "cornflowerblue")
+				    ("yellow" . "navyblue")
+				    ("darkslategrey" . "coral"))
+  "Foreground/background pairs for default buffer text.
+These will show up on the Buffers->Buffer Colors menu."
+  :group 'buffer-colors
+  :initialize 'custom-initialize-default
+  :set (lambda (symbol value)
+	 (set-default symbol value)
+	 (bc-refresh-buffer-color-menu))
+  :type '(repeat (cons :tag "Menu entry"
+		       (color :tag "Foreground")
+		       (color :tag "Background"))))
+
+
+;; a list of rules to start out with.  They can be individualy disabled
+;; and as soon as more are added, and saved in custom.el, those are loaded
+;; instead of this list.
+;;;###autoload
+(defcustom bc-file-color-tests '((t bc-read-only-p "tomato" "black" (bc-read-only))
+				 (t bc-c-file-p "mediumspringgreen" "black" nil)
+				 (t bc-h-file-p "mediumspringgreen" "navy" nil)
+				 (t bc-el-file-p "PaleGreen" "black" nil))
+  "A list of rules for coloring new buffers.
+If a Predicate evaluates to non-nil, the associated color pair will be
+applied to the new buffer.  Predicate will be evaluated in the new
+buffer, so buffer-local variables (eg `buffer-file-name') will be
+correct.
+The last matching rule is used."
+  :group 'buffer-colors
+  :type '(repeat (list :tag "Rule"
+		       :extra-offset 4
+		       (choice :tag "This rule is"
+			       (const :tag "Enabled" t)
+			       (const :tag "Disabled" nil))
+		       (symbol :tag "Predicate")
+		       (string :tag "Foreground")
+		       (string :tag "Background")
+		       (choice :tag "Tag-set"
+			       (const :tag "None" nil)
+			       (repeat :tag "List" (symbol 
+						    :tag "Tag" 
+						    :value bc-read-only))))))
+
+;;;;--- start up code ----------------------------------------------
+
+;;;###autoload
+(unless (featurep 'buffer-colors)
+  (add-menu-button '("Options" "Display")
+		   "---")) ;add a separator only first time loaded
+;;;###autoload
+(add-menu-button '("Options" "Display")
+		 [ "Buffer Colors" bc-toggle-behavior
+		   :style toggle
+		   :selected (behavior-enabled-p 'buffer-colors)])
+
+(provide 'buffer-colors)
+
+;;; end of buffer-colors.el
+
+;;-------- icon-themes.el
+;;  This implements themes for icons in the toolbar
+;;  and adds a menu item "icon-themes"
+;;  each theme is a list of icon files and sizes
+;;  all stored in the file "icon-themes-list.el"
+;;  see that file for a template to add themes.
+;;
+;;  Authors: 
+;;   Byrel Mitchell byrel.mitchell@gmail.com
+;;   Steve Mitchell smitchel@bnin.net
+;;
+;; Copyright (C) 2011 Byrel Mitchell <byrel.mitchell@gmail.com> 
+;; Copyright (C) 2011 Steven Mitchell <smitchel@bnin.net>
+;;
+;; 
+;; This file is part of XEmacs.
+
+;; XEmacs 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 3, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+;;
+
+;---- declare variables for icon-themes ------------------------------
+
+(defvar theme-theme-list nil
+  "A list of all currently loaded themes.")
+;;----  function definitions -----------------------------------------
+
+;--- General Procedure to update the toolbar:
+;--- first save a copy of the default toolbar.  
+;--- then remove the toolbar, 
+;--- then put the saved copy back in, which updates the toolbar
+;--- doesn't seem to be any other way...
+(defun theme-update-toolbar ()
+  (let ((toolbar (copy-specifier default-toolbar)))
+    (remove-specifier default-toolbar)
+    (sit-for 0)
+    (set-specifier default-toolbar toolbar)))
+
+
+
+;--- adds theme-icon-search-path to the data-directory-list path
+(defun theme-expand-path (file)
+  (setq file (substitute-in-file-name file))
+  (if (file-name-absolute-p file)
+      (if (file-exists-p file)
+	  file
+	nil)
+    (locate-file file (append theme-icon-search-path data-directory-list)))) ; when this is a package, would this path already be set?
+
+
+
+;--- theme check files confirms the list of icons in icon-themes-list-el
+;--- to exist on disk so we don't get any missing icon file problems
+;;;###autoload
+(defun theme-check-files ()
+  "Check to make sure all files can be found in all loaded themes."
+  (interactive)
+  (catch 'check-abort
+    (loop for theme-symbol in theme-theme-list
+      for theme = (symbol-value theme-symbol)
+      for theme-name = (car theme) do
+      (loop for (x y . buttons) in (cdr theme) do
+	(loop for (target . icons) in buttons do
+	  (unless (assq target themeable-icons)
+	    (unless (y-or-n-p  (concat (prin1-to-string target) " not in themable icons, in theme " theme-name ". Continue? "))	;or should it be continue checking?
+	      (throw 'check-abort nil)))
+	  (if (eq (type-of icons) 'string)
+	      (setq icons (list icons)))
+	  (loop for image in icons do
+	    (when image
+	      (unless (theme-expand-path image)
+		(unless (y-or-n-p  (concat (prin1-to-string image) " (from theme " theme-name ") not found in path. Continue? "))
+		  (throw 'check-abort nil))))))))
+    t))
+  
+
+; takes the icons of a given theme/size and makes glyphs of them
+(defun theme-load-theme ( theme-list )
+  "Loads theme given by `THEME-LIST' into appropriate glyphs."
+  (loop for (target . icons) in theme-list
+    for target-var = (cdr (assq target themeable-icons))
+    for target-icon = (when (boundp target-var)
+			(symbol-value target-var)) do
+    (when target-var ; Only update icon variable if target is listed in themable icons
+      (unless (boundp target-var) ;if not defined, define target variable
+	(set target-var nil)) 
+      (if (eq (type-of icons) 'string)
+	  (setq icons (list icons)))
+      (when (> (length icons) (length target-icon)) ;length of our list vs target list, includes "pressed",etc. up to 6 items in list   
+	(setf (nthcdr (length target-icon) target-icon) (nthcdr (length target-icon) icons))) ;make sure target list is at least as long as the source list
+      (loop for a from 0 to (1- (min (length target-icon) (length icons))) 
+	for source = (nth a icons) do
+	(if source
+	    (if (theme-expand-path source) ;If we can resolve it to a file, use that. If it doesn't look like a filename, use the string as a glyph
+		(setf (nth a target-icon) (make-glyph (theme-expand-path source)))
+	      (unless (string-match "\\.\\(jpe?g\\|xpm\\|png\\)$" source)
+		(setf (nth a target-icon) (make-glyph source))))
+	  (setf (nth a target-icon) nil)))))
+  (theme-update-toolbar))	      ; at the end, update the toolbar
+
+
+;;;###autoload
+(defun theme-read-theme (theme-list &rest expressions)
+  "Used for loading a theme.
+A theme definition file should contain this function with the theme as
+an argument. If there are any further arguments after a theme definition,
+they are evaluated and run as lisp commands."
+  (let ((theme-name (downcase (car theme-list))) ;Tango for instance has uppercase "T" in name
+	theme-symbol)
+    (while (string-match "[ \t\n]" theme-name)
+      (setq theme-name (replace-match "-" nil nil theme-name)))
+    (setq theme-symbol (intern
+			(concat "theme-"
+				theme-name
+				"-theme-def")))
+    (set theme-symbol theme-list)
+    (unless (member theme-symbol theme-theme-list)
+      (push theme-symbol theme-theme-list)))
+  (eval `(progn ,@expressions))) ;the part that evals any additional commands 
+					;it is used in the text icons to set the
+					; toolbar face to bold.
+
+
+;--- when a new theme is chosen, this function 
+;--- sets the toolbar height and sets the current theme
+;    variables and loads the theme.
+;;;###autoload
+(defun theme-set-theme (symbol theme-symbol &optional x y)
+  "Set the customizable variable theme-current-theme.
+Also set theme-current-size if `X' and `Y' are specified.
+`SYMBOL' is ignored."
+  (if (symbol-value theme-symbol)
+      (progn
+	(unless (and x y)	     ;unless an x and y are specified 
+	  (setq x (caadr (symbol-value theme-symbol)) ; get x from 1st size in theme
+		y (cadadr (symbol-value theme-symbol)))) ;get y from first size in theme
+	(let ((oursize
+	       (loop for (newx newy . icon-list) in (cdr (symbol-value theme-symbol))
+		 until (and (eq x newx)	;once we find a size that matches
+			    (eq y newy))                 
+		 finally return icon-list))) ;return the size we found
+	  (theme-load-theme oursize)	;loads the theme with the size
+	  (set-default 'theme-current-theme theme-symbol) ; set name of current theme
+	  (set-specifier default-toolbar-height (+ 4 y)) ; set toolbar height to match icon height
+	  (set-default 'theme-current-size (cons x y)))) ; set current size of theme
+    (when theme-symbol
+      (setq theme-current-theme theme-symbol)) ;update current theme name
+    (when x
+      (setf (car theme-current-size) x)) ;update width of icons
+    (when y
+      (setf (cdr theme-current-size) y)))) ;update height of icons
+      
+
+
+;--- theme-set-size sets the size of the current theme
+;--- and checks that it is a legitimate size
+;;;###autoload
+(defun theme-set-size (symbol size)
+  "Setting function for `theme-current-size' customizable variable."
+  (if (zerop (loop for (newx newy . icon-list) in (cdr (symbol-value theme-current-theme))
+	       count (and (eq (car size) newx)
+			  (eq (cdr size) newy))))
+      (message "No such size found")
+    (setq theme-current-size size)))
+
+
+;--- theme-load-menu adds the new menu-item "icon-themes"
+;--- the "current: <theme name>" is added to the title line 
+;      of the submenu that lists available themes (by reading
+;      the file "theme-theme-list.el").
+;--- the section below starting with "collect (vector..."
+;      is to populate a sub-menu for each theme, 
+;      showing sizes available in that theme      
+;
+;;;###autoload
+(defun theme-load-menu (menu-path &optional before)
+  "Adds an icon-themes menu to the toolbar.
+`menu-path' is a list representing the menu to add the icon theme menu
+to. `before' is a string indicating what element to add it before. For
+more details, see `current-menubar'."
+  (add-submenu menu-path
+	       '( "Icon Themes" :filter
+		  (lambda (list)
+		    (cons [ "Current: " :suffix (or (car (symbol-value theme-current-theme) ) "none")] ;shows name of cur. theme (or none) 
+					;in submenu title
+			  (loop for theme-symbol in theme-theme-list
+			    for theme = (symbol-value theme-symbol)
+			    collect (cons (car theme) ;
+					  (loop for (x yo) in (cdr theme)
+					    for y = (eval yo)
+					    collect (vector (format "%i x %i" x y) ; assemble a string of x y sizes
+							    `(theme-set-theme nil (quote ,theme-symbol) ,x ,y)    
+							    :style 'radio :selected `(and (eq (quote ,theme-symbol) theme-current-theme)
+										      (eq ,x (car theme-current-size))
+										      (eq ,y (cdr theme-current-size))))))))))
+	       before))
+
+
+(theme-read-theme
+'("Text-Icons"
+   (32 (+ 10 (string-to-number  (custom-face-font-size 'toolbar )))       
+                ; adjust 2nd number above for button height w/your font
+                ;height needs to be 4-6 pixels higher than font height
+                ;or text won't show in the toolbar buttons, 
+                ;but buttons will still work 
+     (open	   " Open " nil nil nil nil nil)   ; to compact the length of toolbar
+     (dired	   " Dired " nil nil nil nil nil)  ; remove the leading/trailing spaces
+     (save         " Save " nil nil nil nil nil)   ; and abbrev. the strings as desired.
+     (print        " Print " nil nil nil nil nil)
+     (cut	   " Cut " nil nil nil nil nil)
+     (copy	   " Copy " nil nil nil nil nil)
+     (paste    	   " Paste " nil nil nil nil nil)
+     (prev-window  " Prev-win " nil nil nil nil nil)
+     (next-window  " Next-win " nil nil nil nil nil)
+     (replace      " Find-Replace " nil nil nil nil nil)
+     (spell        " Spell " nil nil nil nil nil)
+     (undo         " Undo " nil nil nil nil nil)
+     (compile      " Compile " nil nil nil nil nil)
+     (debug        " Debug " nil nil nil nil nil)
+     (email        " Email " nil nil nil nil nil)
+     (info         " Info " nil nil nil nil nil)
+     (news-reader  " News-Reader " nil nil nil nil nil)))
+      ;after the list of icons, any lisp commands here will be eval'd 
+     (custom-set-face-bold 'toolbar t ))    ;set toolbar face, bold on
+
+
+(theme-read-theme
+ '("Default-Icons"
+   (28 (cond ((specifier-instance toolbar-buttons-captioned-p) 38) (30))
+       (open  "toolbar/file-up.xpm"
+	      nil 
+	      "toolbar/file-xx.xpm"
+	      "toolbar/file-cap-up.xpm"
+	      nil
+	      "toolbar/file-cap-xx.xpm")
+       (dired "toolbar/folder-up.xpm"
+	      nil 
+	      "toolbar/folder-xx.xpm"
+	      "toolbar/folder-cap-up.xpm"
+	      nil
+	      "toolbar/folder-cap-xx.xpm")
+       (save  "toolbar/disk-up.xpm"
+	      nil 
+	      "toolbar/disk-xx.xpm"
+	      "toolbar/disk-cap-up.xpm"
+	      nil
+	      "toolbar/disk-cap-xx.xpm")
+       (print "toolbar/printer-up.xpm"
+	      nil 
+	      "toolbar/printer-xx.xpm"
+	      "toolbar/printer-cap-up.xpm"
+	      nil
+	      "toolbar/printer-cap-xx.xpm")
+       (cut	  "toolbar/cut-up.xpm"
+		  nil 
+		  "toolbar/cut-xx.xpm"
+		  "toolbar/cut-cap-up.xpm"
+		  nil
+		  "toolbar/cut-cap-xx.xpm")
+       (copy  "toolbar/copy-up.xpm"
+	      nil 
+	      "toolbar/copy-xx.xpm"
+	      "toolbar/copy-cap-up.xpm"
+	      nil
+	      "toolbar/copy-cap-xx.xpm")
+       (paste "toolbar/paste-up.xpm"
+	      nil 
+	      "toolbar/paste-xx.xpm"
+	      "toolbar/paste-cap-up.xpm"
+	      nil
+	      "toolbar/paste-cap-xx.xpm")
+       (prev-window "toolbar/last-win-up.xpm"
+		    nil 
+		    "toolbar/last-win-xx.xpm"
+		    "toolbar/last-win-cap-up.xpm"
+		    nil
+		    "toolbar/last-win-cap-xx.xpm")
+       (next-window "toolbar/next-win-up.xpm"
+		    nil 
+		    "toolbar/next-win-xx.xpm"
+		    "toolbar/next-win-cap-up.xpm"
+		    nil
+		    "toolbar/next-win-cap-xx.xpm")
+       (replace  "toolbar/replace-up.xpm"
+		 nil 
+		 "toolbar/replace-xx.xpm"
+		 "toolbar/replace-cap-up.xpm"
+		 nil
+		 "toolbar/replace-cap-xx.xpm")
+       (spell    "toolbar/spell-up.xpm"
+		 nil 
+		 "toolbar/spell-xx.xpm"
+		 "toolbar/spell-cap-up.xpm"
+		 nil
+		 "toolbar/spell-cap-xx.xpm")
+       (undo     "toolbar/undo-up.xpm"
+		 nil 
+		 "toolbar/undo-xx.xpm"
+		 "toolbar/undo-cap-up.xpm"
+		 nil
+		 "toolbar/undo-cap-xx.xpm")
+       (info     "toolbar/info-def-up.xpm"
+		 nil 
+		 "toolbar/info-xx.xpm"
+		 "toolbar/info-cap-up.xpm"
+		 nil
+		 "toolbar/info-cap-xx.xpm")
+       (compile  "toolbar/compile-up.xpm"
+		 nil 
+		 "toolbar/compile-xx.xpm"
+		 "toolbar/compile-cap-up.xpm"
+		 nil
+		 "toolbar/compile-cap-xx.xpm")
+       (debug    "toolbar/debug-up.xpm"
+		 nil 
+		 "toolbar/debug-xx.xpm"
+		 "toolbar/debug-cap-up.xpm"
+		 nil
+		 "toolbar/debug-cap-xx.xpm")
+       (email    "toolbar/mail-up.xpm"
+		 nil 
+		 "toolbar/mail-xx.xpm"
+		 "toolbar/mail-cap-up.xpm"
+		 nil
+		 "toolbar/mail-cap-xx.xpm")
+       (news-reader "toolbar/news-up.xpm"
+		    nil 
+		    "toolbar/news-xx.xpm"
+		    "toolbar/news-cap-up.xpm"
+		    nil
+		    "toolbar/news-cap-xx.xpm"))))
+
+;;;;--- initialize icon-themes ------------------------------------------
+
+;;;###autoload
+(theme-load-menu '("Options") "Display") 
+
+
+;;;;---- customize group and variables for icon-themes ------------------------------
+
+(defgroup icon-theme nil
+  "Icon theme customize group")
+
+(defcustom theme-current-size '(28 28)
+  "The current icon theme size.
+Should be a list of two numbers, (x y)."
+  :type '(cons integer integer)
+  :version "21.5"
+  :set (lambda (unused size)
+	 (theme-set-size nil size))
+  :group 'icon-theme
+  :initialize 'custom-initialize-default)
+
+
+(defcustom theme-current-theme 'theme-default-icons-theme-def
+  "Current icon theme."
+  :initialize 'custom-initialize-default
+  :type 'variable
+  :version "21.5"
+  :set (lambda (unused theme)
+	 (theme-set-theme nil theme))
+  :group 'icon-theme)
+
+
+(defcustom theme-icon-search-path '("/usr/local/share/xemacs/xemacs-packages/etc/icon-themes")
+  "A list of directories to search for icons with relative path names.
+This is in addition to the contents of 'data-directory-list'."
+  :type '(repeat :tag "Path" (string :tag "Directory"))
+  :version "21.5")
+
+(defcustom themeable-icons '((open . toolbar-file-icon)
+			     (dired . toolbar-folder-icon)
+			     (save . toolbar-disk-icon)
+			     (print . toolbar-printer-icon)
+			     (cut . toolbar-cut-icon)
+			     (copy . toolbar-copy-icon)
+			     (paste . toolbar-paste-icon)
+			     (prev-window . toolbar-last-win-icon)
+			     (next-window . toolbar-next-win-icon)
+			     (replace . toolbar-replace-icon)
+			     (spell . toolbar-spell-icon)
+			     (undo . toolbar-undo-icon)
+			     (compile . toolbar-compile-icon)
+			     (debug . toolbar-debug-icon)
+			     (email . toolbar-mail-icon)
+			     (calc . toolbar-calc-icon)
+			     (news-reader . toolbar-news-icon)
+			     (info . toolbar-info-icon)
+			     (info-exit . info::toolbar-exit-icon)
+			     (info-next . info::toolbar-next-icon)
+			     (info-prev . info::toolbar-prev-icon)
+			     (info-up . info::toolbar-up-icon)
+			     (xpm-show-chars . xpm-show-chars-icon)
+			     (xpm-hide-chars . xpm-hide-chars-icon)
+			     (xpm-add-color . xpm-color-icon)
+			     (xpm-crop . xpm-crop-icon)
+			     (xpm-pad . xpm-enlarge-icon)
+			     (xpm-help . xpm-help-icon)
+			     (xpm-mirror-h . xpm-m-horiz-icon)
+			     (xpm-mirror-v . xpm-m-vert-icon)
+			     (xpm-rotate-ccw . xpm-r-ccw-icon)
+			     (xpm-rotate-cw . xpm-r-cw-icon)
+			     (xpm-save . xpm-save-icon)   
+			     (xpm-shift-d . xpm-sh-d-icon)
+			     (xpm-shift-l . xpm-sh-l-icon)
+			     (xpm-shift-r . xpm-sh-r-icon)
+			     (xpm-shift-u . xpm-sh-u-icon)
+			     (xpm-undo . xpm-undo-icon)
+			     (w3-back  . w3-toolbar-back-icon)
+			     (w3-find  . w3-toolbar-find-icon)  
+			     (w3-forward  . w3-toolbar-forw-icon)
+			     (w3-help  . w3-toolbar-help-icon)  
+			     (w3-home  . w3-toolbar-home-icon)  
+			     (w3-hotlink  . w3-toolbar-hotl-icon)
+			     (w3-image  . w3-toolbar-imag-icon)  
+			     (w3-open  . w3-toolbar-open-icon)  
+			     (w3-print  . w3-toolbar-print-icon) 
+			     (w3-reload  . w3-toolbar-reld-icon)  
+			     (w3-stop  . w3-toolbar-stop-icon))
+  "Association list of icon names to variables they are stored in."
+  :type '(repeat
+	  (cons
+	   (symbol :tag "Name")
+	   (variable :tag "Variable")))
+  :tag "Themable Icons"
+  :version "21.5")
+
+
+(provide 'icon-themes)
+
+;; icon-themes.el ends here
    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (abbrevlist after-save-commands atomic-extents avoid backup-dir balloon-help big-menubar blink-cursor blink-paren bookmark compare-w completion dabbrev desktop detached-minibuf edit-toolbar fast-lock file-part floating-toolbar flow-ctrl foldout func-menu hippie-exp icomplete id-select info-look iswitchb lazy-lock lazy-shot live-icon makesum man mic-paren paren mode-motion+ outl-mouse outln-18 page-ext blink-paren paren permanent-buffers popper power-macros recent-files redo reportmail resume rsz-minibuf saveconf savehist saveplace scroll-in-place setnu shell-font tempo toolbar-utils tree-menu uniquify vertical-mode where-was-i-db winring autorevert align allout outline narrow-stack highline)
+   provides (abbrevlist after-save-commands atomic-extents avoid backup-dir balloon-help big-menubar blink-cursor blink-paren bookmark compare-w completion dabbrev desktop detached-minibuf edit-toolbar fast-lock file-part floating-toolbar flow-ctrl foldout func-menu hippie-exp icomplete id-select info-look iswitchb lazy-lock lazy-shot live-icon makesum man mic-paren paren mode-motion+ outl-mouse outln-18 page-ext blink-paren paren permanent-buffers popper power-macros recent-files redo reportmail resume rsz-minibuf saveconf savehist saveplace scroll-in-place setnu shell-font tempo toolbar-utils tree-menu uniquify vertical-mode where-was-i-db winring autorevert align allout outline narrow-stack highline icon-themes buffer-colors)
    requires (REQUIRES)
    type single
 ))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.