commit/edit-utils: Steve Mitchell: Removed icon-themes.el from edit-utils; refactoring into seperate package

1 new commit in edit-utils: https://bitbucket.org/xemacs/edit-utils/commits/69fa5e2612ce/ Changeset: 69fa5e2612ce User: Steve Mitchell Date: 2014-01-03 21:10:20 Summary: Removed icon-themes.el from edit-utils; refactoring into seperate package Affected #: 2 files diff -r 0fb7a0efa2fe7c9b30bbb59baefcaa0dee2e5c37 -r 69fa5e2612ce0c0525092ab1c8dde9e3f6070846 Makefile --- a/Makefile +++ b/Makefile ＠＠ -40,11 +40,10 ＠＠ 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 icon-themes.elc \ - search-buffers.elc setnu.elc align.elc autorevert.elc allout.elc \ - narrow-stack.elc highline.elc crm.elc wide-edit.elc buffer-colors.elc \ - list-register.elc which-func.elc find-lisp.elc register-menu.elc \ - register-toolbar.elc + winring.elc vertical-mode.elc power-macros.elc search-buffers.elc \ + setnu.elc align.elc autorevert.elc allout.elc narrow-stack.elc \ + highline.elc crm.elc wide-edit.elc buffer-colors.elc list-register.elc \ + which-func.elc find-lisp.elc register-menu.elc register-toolbar.elc \ diff -r 0fb7a0efa2fe7c9b30bbb59baefcaa0dee2e5c37 -r 69fa5e2612ce0c0525092ab1c8dde9e3f6070846 icon-themes.el --- a/icon-themes.el +++ /dev/null ＠＠ -1,447 +0,0 ＠＠ -;;-------- 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(a)gmail.com -;; Steve Mitchell smitchel(a)bnin.net -;; -;; Copyright (C) 2011 Byrel Mitchell <byrel.mitchell(a)gmail.com&gt; -;; Copyright (C) 2011 Steven Mitchell <smitchel(a)bnin.net&gt; -;; -;; -;; 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. -;; - - -(require 'menubar) ;contains add-sub-menu - -;---- 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 ------------------------------------------ - -(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 Repository URL: https://bitbucket.org/xemacs/edit-utils/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches