3 new commits in edit-utils: https://bitbucket.org/xemacs/edit-utils/changeset/a62ad4a49792/ changeset: a62ad4a49792 user: Norbert Koch date: 2012-01-10 14:52:51 summary: XEmacs Package Release 2.45 affected #: 2 files diff -r 6809d81c434e115e3ac9ebb1d7775f516a65f800 -r a62ad4a49792d000ec06ca150d4d039e00909d0e ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2012-01-10 Norbert Koch <viteno(a)xemacs.org&gt; + + * Makefile (VERSION): XEmacs package 2.45 released. + 2011-05-11 Norbert Koch <viteno(a)xemacs.org&gt; * Makefile (VERSION): XEmacs package 2.44 released. diff -r 6809d81c434e115e3ac9ebb1d7775f516a65f800 -r a62ad4a49792d000ec06ca150d4d039e00909d0e Makefile --- a/Makefile +++ b/Makefile ＠＠ -19,7 +19,7 ＠＠ # This XEmacs package contains independent single file lisp packages -VERSION = 2.44 +VERSION = 2.45 AUTHOR_VERSION = MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org&gt; PACKAGE = edit-utils https://bitbucket.org/xemacs/edit-utils/changeset/98f601f1e9d1/ changeset: 98f601f1e9d1 user: Norbert Koch date: 2012-01-10 14:52:51 summary: Added tag edit-utils-2_45 for changeset a62ad4a49792 affected #: 1 file diff -r a62ad4a49792d000ec06ca150d4d039e00909d0e -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 .hgtags --- a/.hgtags +++ b/.hgtags ＠＠ -150,3 +150,4 ＠＠ f100526f96c75342859221d56ee1386776c68776 sumo-2003-02-05 1aaed3ab7fa47ec2c7aa80aa20e74070d6e4ebb0 sumo-2006-05-10 129ef811720b9bdf33934e421726b0c991363018 edit-utils-2_42 +a62ad4a49792d000ec06ca150d4d039e00909d0e edit-utils-2_45 https://bitbucket.org/xemacs/edit-utils/changeset/ef38cca5c38e/ changeset: ef38cca5c38e user: Norbert Koch date: 2012-01-13 09:43:26 summary: merge affected #: 7 files diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,7 +1,25 ＠＠ +2012-01-12 Vin Shelton <acs(a)xemacs.org&gt; + + * buffer-colors.el: + * icon-themes.el: Remove autoloads that force package loading. + 2012-01-10 Norbert Koch <viteno(a)xemacs.org&gt; * Makefile (VERSION): XEmacs package 2.45 released. +2012-01-06 Steve Mitchell <smitchel(a)bnin.net&gt; + Byrel Mitchell <byrel.mitchell(a)gmail.com&gt; + + * buffer-colors.el : created buffer-colors.el + Allows easy changing of foreground/background colors + via customize buffer, menu, and rule based changing. + +2011-12-22 Vin Shelton <acs(a)xemacs.org&gt; + + * allout.el (outline-version): + * winring.el (winring-version): Set $Revision to the most recent + CVS revision number. + 2011-05-11 Norbert Koch <viteno(a)xemacs.org&gt; * Makefile (VERSION): XEmacs package 2.44 released. diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 Makefile --- a/Makefile +++ b/Makefile ＠＠ -40,9 +40,9 ＠＠ 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 diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 allout.el --- a/allout.el +++ b/allout.el ＠＠ -509,7 +509,7 ＠＠ ;;;_ : Version ;;;_ = outline-version (defvar outline-version - (let ((rcs-rev "$Revision$")) + (let ((rcs-rev "$Revision: 1.1 $")) (condition-case err (save-match-data (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 buffer-colors.el --- /dev/null +++ b/buffer-colors.el ＠＠ -0,0 +1,422 ＠＠ +;;; buffer-colors.el +;;; Copyright (C) 2011 Byrel Mitchell and Steve Mitchell +;;; email: smitchel(a)bnin.net +;;; email: byrel.mitchell(a)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 'menubar) ;contains add-menu-button +(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 ---------------------------------------------- + +(unless (featurep 'buffer-colors) + (add-menu-button '("Options" "Display") + "---")) ;add a separator only first time loaded + +(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 + diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 icon-themes.el --- /dev/null +++ b/icon-themes.el ＠＠ -0,0 +1,447 ＠＠ +;;-------- 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 diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 package-info.in --- a/package-info.in +++ b/package-info.in ＠＠ -13,7 +13,7 ＠＠ 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 )) diff -r 98f601f1e9d1c836f33853a7aa387b4af4cce143 -r ef38cca5c38e2ab5f8db1890e1d37e27534edaa9 winring.el --- a/winring.el +++ b/winring.el ＠＠ -8,7 +8,7 ＠＠ ;; Created: March 1997 ;; Keywords: frames tools -(defconst winring-version "$Revision$" +(defconst winring-version "$Revision: 1.2 $" "winring version number.") ;; This file is part of GNU Emacs. 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