carbon2-commit: Ease customization of faces under point...

Aidan Kehoe aidan-guest at alioth.debian.org
Sat Apr 5 08:42:51 EDT 2008


changeset:   4453:7f3d065a56a176d7567899561d6cb5df5a251e41
user:        Didier Verna <didier at xemacs.org>
date:        Wed Mar 05 10:41:54 2008 +0100
files:       lisp/ChangeLog lisp/cus-edit.el
description:
Ease customization of faces under point...

... by providing an optional prefix argument to customize-face[-other-window].


diff -r 1bf48c59700efe2451da808710e77fc39efd6532 -r 7f3d065a56a176d7567899561d6cb5df5a251e41 lisp/ChangeLog
--- a/lisp/ChangeLog	Wed Mar 05 01:12:53 2008 -0800
+++ b/lisp/ChangeLog	Wed Mar 05 10:41:54 2008 +0100
@@ -1,3 +1,16 @@ 2008-02-16  Michael Sperber  <mike at xemac
+2008-03-05  Didier Verna  <didier at xemacs.org>
+
+	Ease customization of face(s) under point.
+	Suggested by Andreas Rohler.
+
+	* cus-edit.el (custom-face-prompt): New (interactive call). Offer
+	a prefix for choosing a face amongst those at point instead of all
+	of them.
+	* cus-edit.el (customize-face-1): New. Factor out from the
+	functions below.
+	* cus-edit.el (customize-face): Use it.
+	* cus-edit.el (customize-face-other-window): Ditto.
+
 2008-02-16  Michael Sperber  <mike at xemacs.org>
 
 	* autoload.el (autoload-make-autoload-operators,
@@ -7,8 +20,8 @@ 2008-02-16  Michael Sperber  <mike at xemac
 
 2008-02-03  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* iso8859-1.el (ascii-case-table): 
-	Correct the order of the arguments to #'put-case-table-pair. 
+	* iso8859-1.el (ascii-case-table):
+	Correct the order of the arguments to #'put-case-table-pair.
 
 2008-01-25  Michael Sperber  <mike at xemacs.org>
 
@@ -17,8 +30,8 @@ 2008-01-25  Michael Sperber  <mike at xemac
 
 2008-01-21  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* info.el (Info-suffix-list): 
-	Support LZMA compression, as used--oddly--by Mandriva Linux. 
+	* info.el (Info-suffix-list):
+	Support LZMA compression, as used--oddly--by Mandriva Linux.
 
 2008-01-17  Mike Sperber  <mike at xemacs.org>
 
@@ -29,10 +42,10 @@ 2008-01-17  Mike Sperber  <mike at xemacs.o
 
 2008-01-16  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* keydefs.el (global-map): 
+	* keydefs.el (global-map):
 	Bind '(shift delete) to #'kill-primary-selection, as described by
 	Glynn Clements in
-	16434.49191.47038.991206 at cerise.nosuchdomain.co.uk of 2004-02-08. 
+	16434.49191.47038.991206 at cerise.nosuchdomain.co.uk of 2004-02-08.
 
 2008-01-14  Jerry James  <james at xemacs.org>
 
@@ -44,29 +57,29 @@ 2008-01-14  Jerry James  <james at xemacs.o
 
 2008-01-14  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* bytecomp.el (byte-compile-output-file-form): 
+	* bytecomp.el (byte-compile-output-file-form):
 	Bind print-gensym-alist to nil, as we do within
 	byte-compile-output-docform.
 
 2008-01-04  Michael Sperber  <mike at xemacs.org>
 
-        * code-files.el (insert-file-contents):
-        (load): Don't call `substitute-in-file-name' on the file name.
+	* code-files.el (insert-file-contents):
+	(load): Don't call `substitute-in-file-name' on the file name.
 
 2008-01-03  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* cus-edit.el (custom-save-all): 
+	* cus-edit.el (custom-save-all):
 	If the directory containing the custom file doesn't exist, try to
-	create it. Fixes Nick's Crabtree's bug of 
+	create it. Fixes Nick's Crabtree's bug of
 	5fb265820712140145w512fa3bbh355cf76f7e2cf792 at mail.gmail.com ;
 	thank you Nick.
 	* menubar-items.el (default-menubar):
 	In the code to edit the user's init file, try to create the
-	containing directory if it doesn't exist. 
+	containing directory if it doesn't exist.
 
 2008-01-02  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* gtk-init.el (init-post-gtk-win): 
+	* gtk-init.el (init-post-gtk-win):
 	Trust the X11 code to give us decent default fonts.
 
 2008-01-02  Aidan Kehoe  <kehoea at parhasard.net>
@@ -74,7 +87,7 @@ 2008-01-02  Aidan Kehoe  <kehoea at parhasa
 	* x-iso8859-1.el: Removed.
 	* gtk-iso8859-1.el: Removed.
 	These haven't been used in a year and a half. No need to keep them
-	around. 
+	around.
 
 2008-01-02  Mike Sperber  <mike at xemacs.org>
 
@@ -92,7 +105,7 @@ 2008-01-02  Mike Sperber  <mike at xemacs.o
 
 2007-12-31  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* menubar-items.el (default-menubar): 
+	* menubar-items.el (default-menubar):
 	Byte compile the specified lambdas. Correct some compile time
 	warnings uncovered by this.
 	* menubar-items.el (tutorials-menu-filter):
@@ -100,7 +113,7 @@ 2007-12-31  Aidan Kehoe  <kehoea at parhasa
 	specified--which indicates we don't want it used except by those
 	who know what they're doing--don't show its tutorial in the menu.
 	* behavior.el (behavior-menu-filter):
-	Byte compile the lambdas in the generated menu. 
+	Byte compile the lambdas in the generated menu.
 
 2007-12-30  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -111,15 +124,15 @@ 2007-12-30  Aidan Kehoe  <kehoea at parhasa
 
 	* subr.el (with-case-table): New.
 	Idea and implementation taken from GNU's code of April 2007,
-	before GPL V3 was implied. Thank you GNU. 
-	* iso8859-1.el (ascii-case-table): New. 
+	before GPL V3 was implied. Thank you GNU.
+	* iso8859-1.el (ascii-case-table): New.
 	Idea taken from GNU.
 	* iso8859-1.el :
 	Change Jamie's implicit compile-time call to a macro literal into
 	something comprehensible to and maintainable by mortals, using to
 	cl.el's #'loop.
 	* iso8859-1.el (ctl-arrow):
-	Initialise it to something more comprehensible. 
+	Initialise it to something more comprehensible.
 
 2007-12-30  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -127,10 +140,10 @@ 2007-12-30  Aidan Kehoe  <kehoea at parhasa
 	Accept a new TYPE argument, compatible with GNU, saying
 	whether function or variable definitions should be searched for.
 	Implement the functionality for autoloads, handling TYPE
-	correctly. 
+	correctly.
 	Pass the TYPE argument to built-in-symbol-file correctly.
 	Document that TYPE is not implemented for non-autoloaded Lisp
-	definitions. Our load-history doesn't have the relevant metadata. 
+	definitions. Our load-history doesn't have the relevant metadata.
 
 2007-12-25  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -138,7 +151,7 @@ 2007-12-25  Aidan Kehoe  <kehoea at parhasa
 	Revert part of Didier's 2007-10-15 commit, which broke
 	#'make-image-specifier with string arguments, and more noticeably
 	truncation-glyph, continuation-glyph, octal-escape-glyph,
-	control-arrow-glyph. 
+	control-arrow-glyph.
 
 2007-12-23  Mike Sperber  <mike at xemacs.org>
 
@@ -184,19 +197,19 @@ 2007-12-18  Aidan Kehoe  <kehoea at parhasa
 	* help.el (describe-function-1):
 	Give details of bindings for commands, taking into account
 	global-window-system-map and global-tty-map when bindings differ
-	compared to the global map. 
+	compared to the global map.
 
 2007-12-17  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* subr.el (integer-to-bit-vector): New.
 	* subr.el (bit-vector-to-integer): New.
-	Provide naive implementations using the Lisp reader for these. 
+	Provide naive implementations using the Lisp reader for these.
 
 2007-12-14  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* process.el (substitute-env-vars):
-	Merge an example from GNU's docstring. 
-	* process.el (setenv):	
+	Merge an example from GNU's docstring.
+	* process.el (setenv):
 	Pass nil as the default abbrev table to the #'read-from-minibuffer
 	call, instead of passing the current value of the variable. Bug
 	introduced by an incorrect sync from GNU by Ben; reported by
@@ -205,7 +218,7 @@ 2007-12-14  Aidan Kehoe  <kehoea at parhasa
 	Document the #'set-time-zone-rule call when TZ is set. Push the
 	old value on to the beginning of setenv-history. (Both merged from
 	GNU.) Document that we don't do the coding-system frobbing at this
-	level that GNU does. 
+	level that GNU does.
 
 	Provide a commented-out, sample implementation of GNU's
 	#'environment; document why I think we shouldn't include it.
@@ -233,10 +246,10 @@ 2007-12-09  Aidan Kehoe  <kehoea at parhasa
 
 	* unicode.el (load-unicode-mapping-tables):
 	Call #'set-default-unicode-precedence wrapped with
-	#'declare-fboundp, to avoid warnings on non-Mule builds. 
+	#'declare-fboundp, to avoid warnings on non-Mule builds.
 
 	* unicode.el (ccl-encode-to-ucs-2):
-	* unicode.el (unicode-error-sequence-regexp-range):	
+	* unicode.el (unicode-error-sequence-regexp-range):
 	* unicode.el (frob-unicode-errors-region):
 	* unicode.el (unicode-error-translate-region):
 	Unconditionally provide these functions and variables at top
@@ -247,11 +260,11 @@ 2007-12-09  Aidan Kehoe  <kehoea at parhasa
 
 	Unintern the function and variable symbols if (featurep 'mule) is
 	not true, so their function definitions and so on get garbage
-	collected at dump time in non-Mule builds. 
-
-	* obsolete.el (add-menu-item): 
-	* obsolete.el (add-menu): 
-	* obsolete.el (add-menu): 
+	collected at dump time in non-Mule builds.
+
+	* obsolete.el (add-menu-item):
+	* obsolete.el (add-menu):
+	* obsolete.el (add-menu):
 	* obsolete.el (package-get-download-menu):
 	Provide these functions at top level, in order to make them
 	available to make-docfile.c, which has trouble interpreting byte
@@ -261,17 +274,17 @@ 2007-12-09  Aidan Kehoe  <kehoea at parhasa
 
 2007-12-09  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* mule/latin.el: 
+	* mule/latin.el:
 	Create clones of the English language environment with UTF-8 and
 	Windows-1252 as the associated coding system, for Joachim Schrod's
-	use case of f8q022$3o3$1 at sea.gmane.org. 
+	use case of f8q022$3o3$1 at sea.gmane.org.
 
 2007-12-04  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* keydefs.el:
 	Bind mouse wheel movements by default, to a lambda that calls the
 	autoloaded #'mwheel-install and then #'mwheel-scroll with the
-	appropriate event. 
+	appropriate event.
 
 2007-12-07  Vin Shelton  <acs at xemacs.org>
 
@@ -281,20 +294,20 @@ 2007-12-05  Aidan Kehoe  <kehoea at parhasa
 
 	* code-files.el (write-region):
 	Use a more concise and probably less confusing docstring from
-	Stephen. See 
-	87ve84323s.fsf at uwakimon.sk.tsukuba.ac.jp. 
+	Stephen. See
+	87ve84323s.fsf at uwakimon.sk.tsukuba.ac.jp.
 
 	Not following his suggestion of keeping the CODING-SYSTEM name for
 	the last argument, given that that would make reworking the
 	body of the necessary, and that I introduced a short-lived bug the
-	last time I did that. 
+	last time I did that.
 
 2007-12-03  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* bytecomp.el (byte-compile-file-form-custom-declare-variable):
 	Instead of using a keyword argument that's incompatible with 21.4,
 	modify the byte compiled init code to change the variable's
-	standard-value property itself. 
+	standard-value property itself.
 
 2007-12-04  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -302,12 +315,12 @@ 2007-12-04  Aidan Kehoe  <kehoea at parhasa
 	* mule/iso-with-esc.el ('iso-latin-1-with-esc): New.
 	Provide the variable-length rarely-used ISO 2022 compatible coding
 	systems for Latin (that is, iso-8859-[1-16]) again, to address
-	Stephen's veto. 
+	Stephen's veto.
 
 2007-12-04  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* autoload.el (make-autoload):
-	Support auto-autoloads for coding systems. 
+	Support auto-autoloads for coding systems.
 
 2007-12-01  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -327,7 +340,7 @@ 2007-12-01  Aidan Kehoe  <kehoea at parhasa
 	unification problems the old implementation had.
 
 	Add aliases for GNU compatibility.
-	  
+
 	Still no warning on the imminent corruption of data, though. I'm
 	working on it.
 	* mule/greek.el (windows-1253):
@@ -340,7 +353,7 @@ 2007-12-01  Aidan Kehoe  <kehoea at parhasa
 	print-gensym-alist on exit from #'print. This is appropriate
 	because #'byte-compile-output-file-form may be called multiple
 	times for a given output file, and re-using the
-	#1=#:... placeholders in that context is inappropriate. 
+	#1=#:... placeholders in that context is inappropriate.
 
 2007-11-29  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -351,7 +364,7 @@ 2007-11-29  Aidan Kehoe  <kehoea at parhasa
 	and run-time code didn't share this value.
 	* mule/mule-coding.el (make-8-bit-coding-system):
 	Mark the coding systems created by this code as such, for the sake
-	of automated testing of their round-trip compatibility. 
+	of automated testing of their round-trip compatibility.
 
 2007-11-28  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -365,7 +378,7 @@ 2007-11-28  Aidan Kehoe  <kehoea at parhasa
 
 	* mule/mule-cmds.el (create-variant-language-environment):
 	Set tutorial-coding-system to correspond to the original coding
-	system when creating the variant language environment. 
+	system when creating the variant language environment.
 
 2007-11-27  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -380,9 +393,9 @@ 2007-11-27  Aidan Kehoe  <kehoea at parhasa
 	a) the byte compilation warnings and b) since our interpreter is
 	proportionately so much slower than theirs, we are penalised more
 	strongly when we interpret code, especially when
-	#'custom-declare-variable calls cluster, as they tend to do. 
+	#'custom-declare-variable calls cluster, as they tend to do.
 	* cus-edit.el (customize-changed-options):
-	Wrap the #'interactive call to be less than 80 columns. 
+	Wrap the #'interactive call to be less than 80 columns.
 	Wrap the code to less than 80 columns.
 	* cus-edit.el (custom-variable-menu):
 	* cus-edit.el (custom-face-menu):
@@ -392,16 +405,16 @@ 2007-11-27  Aidan Kehoe  <kehoea at parhasa
 	* custom.el (custom-initialize-changed):
 	Correct the docstring; change the defun to defsubst, since calls
 	to this are only done from one function, and calls to that
-	function cluster. 
+	function cluster.
 	* custom.el (custom-declare-variable):
 	Document the :default argument to #'custom-declare-variable;
-	implement it. 
+	implement it.
 
 2007-11-27  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* byte-optimize.el (byte-optimize-featurep):
 	Remove a useless let binding that was a hangover from an earlier
-	version of the code. Eliminates a byte-compile time warning. 
+	version of the code. Eliminates a byte-compile time warning.
 
 2007-11-22  Vin Shelton  <acs at xemacs.org>
 
@@ -412,19 +425,19 @@ 2007-11-15  Aidan Kehoe  <kehoea at parhasa
 	* code-files.el (write-region):
 	Call #'find-coding-system on the (possible) coding system argument
 	before checking it with #'coding-system-p; the latter function
-	gives false results when passed coding system names as symbols. 
+	gives false results when passed coding system names as symbols.
 
 	Preserve the old order of determination of the coding system
 	better.
 
 2007-11-14  Aidan Kehoe  <kehoea at parhasard.net>
 
-	* unicode.el (unicode-error-default-translation-table): 
+	* unicode.el (unicode-error-default-translation-table):
 	* unicode.el (unicode-error-sequence-regexp-range):
 	* unicode.el (frob-unicode-errors-region):
 	Make these variables and the single function available to
 	make-docfile, by moving them to the start of the line. This
-	conflicts with normal indentation of Lisp, unfortunately. 
+	conflicts with normal indentation of Lisp, unfortunately.
 
 2007-11-14  Aidan Kehoe  <kehoea at parhasard.net>
 
@@ -433,32 +446,32 @@ 2007-11-14  Aidan Kehoe  <kehoea at parhasa
 	* subr.el (string-to-vector):
 	(append STRING nil) is faster than (mapcar #'identity STRING),
 	(vconcat STRING) is faster than (mapcar #'identity STRING). Change
-	from GNU. 
+	from GNU.
 
 2007-11-14  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* code-files.el (write-region):
 	Provide a new arg, CODING-SYSTEM-OR-MUSTBENEW, for compatibility
 	both with GNU (where it has the MUSTBENEW meaning) and earlier
-	XEmacs code (where it has the CODING-SYSTEM meaning). 
+	XEmacs code (where it has the CODING-SYSTEM meaning).
 	* files.el:
 	* files.el (normal-backup-enable-predicate):
 	* files.el (auto-save-file-name-transforms):
 	Correct the docstrings of #'normal-backup-enable-predicate,
 	#'auto-save-file-name-transforms.
 	* files.el (make-temp-file): New.
-	Merge from GNU. 
+	Merge from GNU.
 	* subr.el:
-	Document that #'make-temp-name is now in files.el. 
+	Document that #'make-temp-name is now in files.el.
 
 2007-11-08  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* cus-edit.el (custom-save-all):
-	Merge Jason Spiro's fix of 
+	Merge Jason Spiro's fix of
 	c241693f0710021645g642f145n5925c7a35e7b2c58 at mail.gmail.com , to
 	avoid corruption of the custom-set-variables and custom-set-fonts
 	calls in ~/.emacs if XEmacs doesn't understand any part of the
-	syntax of ~/.emacs . 
+	syntax of ~/.emacs .
 
 2007-10-31  Mike Sperber  <mike at xemacs.org>
 
@@ -471,15 +484,15 @@ 2007-10-26  Aidan Kehoe  <kehoea at parhasa
 	* mule/general-late.el:
 	Now that all the dumped coding systems are available, decode
 	Installation-string using the value for
-	Installation-file-coding-system at dump time. 
+	Installation-file-coding-system at dump time.
 
 2007-10-26  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* dumped-lisp.el (preloaded-file-list):
-	Allow version.el to be compiled. 
+	Allow version.el to be compiled.
 	* help.el (describe-installation):
 	Use and-boundp instead of (and (boundp ...); don't decode
-	Installation-string. Call #'error with a DATUM arg. 
+	Installation-string. Call #'error with a DATUM arg.
 	* loadup.el:
 	* loadup.el (Installation-string): Removed.
 	Moved to version.el.
@@ -489,13 +502,13 @@ 2007-10-26  Aidan Kehoe  <kehoea at parhasa
 	* update-elc-2.el (batch-update-elc-2):
 	Remove version.el from the ignored files; if Mule is available,
 	always recompile it, since Installation-file-coding-system depends
-	on relatively complex Mule code. 
+	on relatively complex Mule code.
 	* update-elc.el (unbytecompiled-lisp-files):
 	Remove version.el.
 	* version.el:
 	* version.el (Installation-file-coding-system): New.
 	Variable reflecting the native coding system at build time, to
-	better work out Installation-string. 
+	better work out Installation-string.
 	* version.el (Installation-string): New.
 	Moved from loadup.el; documented in more detail.
 
@@ -516,14 +529,14 @@ 2007-10-01  Aidan Kehoe  <kehoea at parhasa
 	refuses to run on GNU Emacs. Also optimises away checks for cl,
 	cl-extra, cl-19 and backquote, a conservative list of those
 	features that have been available in every XEmacs build since the
-	last time our opcodes changed. 
+	last time our opcodes changed.
 
 2007-10-14  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* coding.el:
 	Use raw-text, not no-conversion for iso-8859-1 on non-Mule;
 	preserves the line ending autodetection, but doesn't do coding
-	system autodetection. Thank you Stephen. 
+	system autodetection. Thank you Stephen.
 
 2007-10-15  Didier Verna  <didier at xemacs.org>
 
diff -r 1bf48c59700efe2451da808710e77fc39efd6532 -r 7f3d065a56a176d7567899561d6cb5df5a251e41 lisp/cus-edit.el
--- a/lisp/cus-edit.el	Wed Mar 05 01:12:53 2008 -0800
+++ b/lisp/cus-edit.el	Wed Mar 05 10:41:54 2008 +0100
@@ -1,6 +1,6 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
-;; Copyright (C) 2007 Didier Verna
+;; Copyright (C) 2007, 2008 Didier Verna
 ;; Copyright (C) 2003 Ben Wing
 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
 ;;
@@ -836,7 +836,7 @@ This means, in other words, variables de
 		       (and version
 			    (or (null since-version)
 				(customize-version-lessp since-version
-                                                         version))))
+							 version))))
 		     (push (list symbol 'custom-variable) found))))
     (unless found
       (error "No user options have changed defaults %s"
@@ -870,39 +870,86 @@ Show the buffer in another window, but d
    (list (list symbol 'custom-variable))
    (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
 
+
+(defun custom-face-prompt ()
+  ;; Interactive call for `customize-face' and `customize-face-other-window'.
+  ;; See their docstrings for more information. Note that this call returns a
+  ;; list of only one element. This is because the callers'second arg AT-POINT
+  ;; is only used in interactive calls.
+  (let ((faces (get-char-property (point) 'face)))
+    (if (or (null faces) (not current-prefix-arg))
+	;; The default behavior, which is to prompt for all faces, is also
+	;; used as a fall back when a prefix is given but there's no face
+	;; under point:
+	(let ((choice (completing-read "Customize face: (default all) "
+				       obarray 'find-face)))
+	  (if (zerop (length choice))
+	      nil
+	    (list (intern choice))))
+      (cond ((symbolp faces)
+	     ;; Customize only this one:
+	     (list (list faces)))
+	    ((listp faces)
+	     ;; Make a choice only amongst the faces under point:
+	     (let ((choice (completing-read
+			    "Customize face: (default all faces at point) "
+			    (mapcar (lambda (face)
+				      (list (symbol-name face) face))
+				    faces)
+			    nil t)))
+	       (if (zerop (length choice))
+		   (list faces)
+		 (list (intern choice)))))))))
+
+(defun customize-face-1 (face custom-buffer-create-fn)
+  ;; Customize FACE in a buffer created with BUFFER-CREATE-FN.
+  ;; See the docstring of `customize-face' and `customize-face-other-window'
+  ;; for more information.
+  (cond ((null face)
+	 (funcall custom-buffer-create-fn
+		  (custom-sort-items
+		   (mapcar (lambda (symbol)
+			     (list symbol 'custom-face))
+			   (face-list))
+		   t nil)
+		  "*Customize All Faces*"))
+	((listp face)
+	 (funcall custom-buffer-create-fn
+		  (custom-sort-items
+		   (mapcar (lambda (symbol)
+			     (list symbol 'custom-face))
+			   face)
+		   t nil)
+		  "*Customize Some Faces*"))
+	((symbolp face)
+	 (funcall custom-buffer-create-fn
+		  (list (list face 'custom-face))
+		  (format "*Customize Face: %s*"
+			  (custom-unlispify-tag-name face))))
+	(t
+	 (signal-error 'wrong-type-argument
+		       '((or null listp symbolp) face)))))
+
+
 ;;;###autoload
-(defun customize-face (&optional symbol)
-  "Customize SYMBOL, which should be a face name or nil.
-If SYMBOL is nil, customize all faces."
-  (interactive (list (completing-read "Customize face: (default all) "
-				      obarray 'find-face)))
-  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
-      (custom-buffer-create (custom-sort-items
-			     (mapcar (lambda (symbol)
-				       (list symbol 'custom-face))
-				     (face-list))
-			     t nil)
-			    "*Customize Faces*")
-    (when (stringp symbol)
-      (setq symbol (intern symbol)))
-    (check-argument-type 'symbolp symbol)
-    (custom-buffer-create (list (list symbol 'custom-face))
-			  (format "*Customize Face: %s*"
-				  (custom-unlispify-tag-name symbol)))))
+(defun customize-face (&optional face at-point)
+  "Open a customization buffer for FACE.
+FACE should be either:
+- nil, meaning to customize all faces,
+- a list of symbols naming faces, meaning to customize only those,
+- a symbol naming a face, meaning to customize this face only.
+
+When called interactively, use a prefix (the AT-POINT argument) to
+make a choice among the faces found at current position."
+  (interactive (custom-face-prompt))
+  (customize-face-1 face #'custom-buffer-create))
 
 ;;;###autoload
-(defun customize-face-other-window (&optional symbol)
-  "Show customization buffer for FACE in other window."
-  (interactive (list (completing-read "Customize face: "
-				      obarray 'find-face)))
-  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
-      ()
-    (if (stringp symbol)
-	(setq symbol (intern symbol)))
-    (check-argument-type 'symbolp symbol)
-    (custom-buffer-create-other-window
-     (list (list symbol 'custom-face))
-     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
+(defun customize-face-other-window (&optional face at-point)
+  "Like `customize-face', but use another window."
+  (interactive (custom-face-prompt))
+  (customize-face-1 face #'custom-buffer-create-other-window))
+
 
 ;;;###autoload
 (defun customize-customized ()
@@ -2207,35 +2254,35 @@ Otherwise, look up symbol in `custom-gue
 (defvar custom-variable-menu
   `(("Set for Current Session" custom-variable-set
      ,#'(lambda (widget)
-          (eq (widget-get widget :custom-state) 'modified)))
+	  (eq (widget-get widget :custom-state) 'modified)))
     ("Save for Future Sessions" custom-variable-save
      ,#'(lambda (widget)
-          (memq (widget-get widget :custom-state)
-                '(modified set changed rogue))))
+	  (memq (widget-get widget :custom-state)
+		'(modified set changed rogue))))
     ("Reset to Current" custom-redraw
      ,#'(lambda (widget)
-          (and (default-boundp (widget-value widget))
-               (memq (widget-get widget :custom-state) '(modified changed)))))
+	  (and (default-boundp (widget-value widget))
+	       (memq (widget-get widget :custom-state) '(modified changed)))))
     ("Reset to Saved" custom-variable-reset-saved
      ,#'(lambda (widget)
-          (and (or (get (widget-value widget) 'saved-value)
-                   (get (widget-value widget) 'saved-variable-comment))
-               (memq (widget-get widget :custom-state)
-                     '(modified set changed rogue)))))
+	  (and (or (get (widget-value widget) 'saved-value)
+		   (get (widget-value widget) 'saved-variable-comment))
+	       (memq (widget-get widget :custom-state)
+		     '(modified set changed rogue)))))
     ("Reset to Standard Settings" custom-variable-reset-standard
      ,#'(lambda (widget)
-          (and (get (widget-value widget) 'standard-value)
-               (memq (widget-get widget :custom-state)
-                     '(modified set changed saved rogue)))))
+	  (and (get (widget-value widget) 'standard-value)
+	       (memq (widget-get widget :custom-state)
+		     '(modified set changed saved rogue)))))
     ("---" ignore ignore)
     ("Add Comment" custom-comment-show custom-comment-invisible-p)
     ("---" ignore ignore)
     ("Don't show as Lisp expression" custom-variable-edit
      ,#'(lambda (widget)
-          (eq (widget-get widget :custom-form) 'lisp)))
+	  (eq (widget-get widget :custom-form) 'lisp)))
     ("Show as Lisp expression" custom-variable-edit-lisp
      ,#'(lambda (widget)
-          (eq (widget-get widget :custom-form) 'edit))))
+	  (eq (widget-get widget :custom-form) 'edit))))
   "Alist of actions for the `custom-variable' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -2701,23 +2748,23 @@ Match frames with dark backgrounds")
     ("Save for Future Sessions" custom-face-save)
     ("Reset to Saved" custom-face-reset-saved
      ,#'(lambda (widget)
-          (or (get (widget-value widget) 'saved-face)
-              (get (widget-value widget) 'saved-face-comment))))
+	  (or (get (widget-value widget) 'saved-face)
+	      (get (widget-value widget) 'saved-face-comment))))
     ("Reset to Standard Setting" custom-face-reset-standard
      ,#'(lambda (widget)
-          (get (widget-value widget) 'face-defface-spec)))
+	  (get (widget-value widget) 'face-defface-spec)))
     ("---" ignore ignore)
     ("Add Comment" custom-comment-show custom-comment-invisible-p)
     ("---" ignore ignore)
     ("Show all display specs" custom-face-edit-all
      ,#'(lambda (widget)
-          (not (eq (widget-get widget :custom-form) 'all))))
+	  (not (eq (widget-get widget :custom-form) 'all))))
     ("Just current attributes" custom-face-edit-selected
      ,#'(lambda (widget)
-          (not (eq (widget-get widget :custom-form) 'selected))))
+	  (not (eq (widget-get widget :custom-form) 'selected))))
     ("Show as Lisp expression" custom-face-edit-lisp
      ,#'(lambda (widget)
-          (not (eq (widget-get widget :custom-form) 'lisp)))))
+	  (not (eq (widget-get widget :custom-form) 'lisp)))))
   "Alist of actions for the `custom-face' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -3341,19 +3388,19 @@ Creating group members... %2d%%"
 (defvar custom-group-menu
   `(("Set for Current Session" custom-group-set
      ,#'(lambda (widget)
-          (eq (widget-get widget :custom-state) 'modified)))
+	  (eq (widget-get widget :custom-state) 'modified)))
     ("Save for Future Sessions" custom-group-save
      ,#'(lambda (widget)
-          (memq (widget-get widget :custom-state) '(modified set))))
+	  (memq (widget-get widget :custom-state) '(modified set))))
     ("Reset to Current" custom-group-reset-current
      ,#'(lambda (widget)
-          (memq (widget-get widget :custom-state) '(modified))))
+	  (memq (widget-get widget :custom-state) '(modified))))
     ("Reset to Saved" custom-group-reset-saved
      ,#'(lambda (widget)
-          (memq (widget-get widget :custom-state) '(modified set))))
+	  (memq (widget-get widget :custom-state) '(modified set))))
     ("Reset to standard setting" custom-group-reset-standard
      ,#'(lambda (widget)
-          (memq (widget-get widget :custom-state) '(modified set saved)))))
+	  (memq (widget-get widget :custom-state) '(modified set saved)))))
   "Alist of actions for the `custom-group' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -3767,12 +3814,12 @@ Hashes several heavily used functions fo
     (custom-save-faces)
     (let ((find-file-hooks nil)
 	  (auto-mode-alist)
-          custom-file-directory)
-      (unless (file-directory-p (setq custom-file-directory 
-                                      (file-name-directory custom-file)))
-        (message "Creating %s... " custom-file-directory)
-        (make-directory custom-file-directory t)
-        (message "Creating %s... done." custom-file-directory))
+	  custom-file-directory)
+      (unless (file-directory-p (setq custom-file-directory
+				      (file-name-directory custom-file)))
+	(message "Creating %s... " custom-file-directory)
+	(make-directory custom-file-directory t)
+	(message "Creating %s... done." custom-file-directory))
       (with-current-buffer (find-file-noselect custom-file)
 	(save-buffer)))))
 




More information about the XEmacs-Patches mailing list