CVS update by didierv xemacs/lisp ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Thu Sep 20 17:18:37 EDT 2007
User: didierv
Date: 07/09/20 23:18:37
Modified: xemacs/lisp ChangeLog wid-edit.el cus-edit.el
Log:
User options interactive prompting improvements
Revision Changes Path
1.839 +33 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.838
retrieving revision 1.839
diff -u -p -r1.838 -r1.839
--- ChangeLog 2007/09/19 14:49:07 1.838
+++ ChangeLog 2007/09/20 21:18:33 1.839
@@ -1,3 +1,36 @@
+2007-09-20 Didier Verna <didier at xemacs.org>
+
+ Improvements in user options interactive prompting. This mainly
+ involves the following: before this patch, options of type 'group
+ or 'checklist were prompted by full sexp, without taking a
+ possible default value into account. Now, the user interaction
+ features individual prompting _with completion_ for each group or
+ checklist member. For group options, an optional default value is
+ also handled on an individual group member basis.
+
+ * cus-edit.el (customize-set-value): Suppress the final ": " from
+ created prompts.
+ (customize-set-variable): Ditto.
+ (customize-save-variable): Ditto.
+ (custom-prompt-variable): Add final ": " to prompts if needed.
+
+ * wid-edit.el (widget-prompt-spaceify): New. Add trailing space to
+ string if needed.
+ (widget-prompt): New. Construct a prompt for a widget.
+ (widget-prompt-value): Use it; make prompt argument optional.
+ (widget-default-prompt-value): Add final ": " to prompt.
+ (widget-field-prompt-internal): Ditto.
+ (widget-sexp-prompt-value): Ditto.
+ (widget-file-prompt-value): Ditto.
+ (widget-symbol-prompt-internal): Ditto.
+ (widget-choice-prompt-value): Ditto.
+ (widget-boolean-prompt-value): Ditto.
+ (widget-checklist-prompt-value): New. Prompt value with completion.
+ (checklist): Make the widget aware of it.
+ (widget-group-prompt-value): New. Prompt value with completion;
+ handle default value individually for each group member.
+ * wid-edit.el (group): Make the widget aware of it.
+
2007-09-19 Didier Verna <didier at xemacs.org>
Update my personal info.
1.33 +146 -60 XEmacs/xemacs/lisp/wid-edit.el
Index: wid-edit.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/wid-edit.el,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -p -r1.32 -r1.33
--- wid-edit.el 2006/03/17 16:50:04 1.32
+++ wid-edit.el 2007/09/20 21:18:34 1.33
@@ -1,9 +1,10 @@
;;; wid-edit.el --- Functions for creating and using widgets.
;;
+;; Copyright (C) 2007 Didier Verna
;; Copyright (C) 1996-1997, 1999-2002 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham at dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic at xemacs.org>
+;; Maintainer: Didier Verna <didier at xemacs.org>
;; Keywords: extensions
;; Version: 1.9960-x
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -330,7 +331,7 @@ menu will be used, otherwise the minibuf
(mouse-set-point event)
(let ((pos (event-point event)))
(if (and pos (get-char-property pos 'button))
- (widget-button-click event))))
+ (widget-button-click event))))
;;; Widget text specifications.
;;
@@ -591,15 +592,15 @@ Suitable for use with `map-extents'."
(defun widget-specify-active (widget)
"Make WIDGET active for user modifications."
(let ((inactive (widget-get widget :inactive))
- (from (widget-get widget :from))
- (to (widget-get widget :to)))
+ (from (widget-get widget :from))
+ (to (widget-get widget :to)))
(when (and inactive (not (extent-detached-p inactive)))
;; Reactivate the buttons and fields covered by the extent.
(map-extents 'widget-activation-widget-mapper
- nil from to :activate nil 'button-or-field)
+ nil from to :activate nil 'button-or-field)
;; Reactivate the glyphs.
(map-extents 'widget-activation-glyph-mapper
- nil from to :activate nil 'end-glyph)
+ nil from to :activate nil 'end-glyph)
(delete-extent inactive)
(widget-put widget :inactive nil))))
@@ -706,15 +707,44 @@ ARGS are passed as extra arguments to th
;;
;; These are widget specific.
+;; #### Note: this should probably be a more general utility -- dvl
+(defsubst widget-prompt-spaceify (prompt)
+ ;; Add a space at the end of PROMPT if needed
+ (if (or (string= prompt "") (eq ? (aref prompt (1- (length prompt)))))
+ prompt
+ (concat prompt " ")))
+
+(defsubst widget-prompt (widget &optional prompt default-prompt)
+ ;; Construct a prompt for WIDGET.
+ ;; - If PROMPT is given, use it.
+ ;; - Otherwise, use the :tag property, if any.
+ ;; - Otherwise, use DEFAULT-PROMPT, if given.
+ ;; - Otherise, use "Value".
+ ;; - If the result is not the empty string, add a space for later addition
+ ;; of the widget type by `widget-prompt-value'.
+ (unless prompt
+ (setq prompt (or (and (widget-get widget :tag)
+ (replace-in-string (widget-get widget :tag)
+ "^[ \t]+" "" t))
+ default-prompt
+ "Value")))
+ (widget-prompt-spaceify prompt))
+
+
;;;###autoload
-(defun widget-prompt-value (widget prompt &optional value unbound)
- "Prompt for a value matching WIDGET, using PROMPT.
+(defun widget-prompt-value (widget &optional prompt value unbound)
+ "Prompt for a value matching WIDGET.
+Prompt with PROMPT, or WIDGET's :tag otherwise.
The current value is assumed to be VALUE, unless UNBOUND is non-nil."
(unless (listp widget)
(setq widget (list widget)))
- (setq prompt (format "[%s] %s" (widget-type widget) prompt))
(setq widget (widget-convert widget))
- (let ((answer (widget-apply widget :prompt-value prompt value unbound)))
+ (let ((answer (widget-apply widget
+ :prompt-value
+ (format "%s[%s]"
+ (widget-prompt widget prompt)
+ (widget-type widget))
+ value unbound)))
(while (not (widget-apply widget :match answer))
(setq answer (signal 'error (list "Answer does not match type"
answer (widget-type widget)))))
@@ -1783,11 +1813,11 @@ If that does not exists, call the value
(lambda () ;?\]
(setq button-end (point-marker))
(set-marker-insertion-type button-end nil))
- (lambda () ;?\{
+ (lambda () ;?\{
(setq sample-begin (point)))
(lambda () ;?\}
(setq sample-end (point)))
- (lambda () ;?n
+ (lambda () ;?n
(when (widget-get widget :indent)
(insert ?\n)
(insert-char ?\ (widget-get widget :indent))))
@@ -2001,7 +2031,7 @@ If that does not exists, call the value
;; It would be nice if we could do a `(cons val 1)' here.
;; (prin1-to-string (custom-quote value))))))
;; XEmacs: make this use default VALUE. Need to check callers.
- (eval-minibuffer prompt))
+ (eval-minibuffer (concat prompt ": ")))
;;; The `item' Widget.
@@ -2224,7 +2254,7 @@ and `:help-echo' members."
"Read string for WIDGET prompting with PROMPT.
INITIAL is the initial input and HISTORY is a symbol containing
the earlier input."
- (read-string prompt initial history))
+ (read-string (concat prompt ": ") initial history))
(defun widget-field-prompt-value (widget prompt value unbound)
"Prompt for a string."
@@ -2577,6 +2607,7 @@ The parent of several `checkbox' widgets
:value-create 'widget-checklist-value-create
:value-delete 'widget-children-value-delete
:value-get 'widget-checklist-value-get
+:prompt-value 'widget-checklist-prompt-value
:validate 'widget-checklist-validate
:match 'widget-checklist-match
:match-inline 'widget-checklist-match-inline)
@@ -2701,6 +2732,27 @@ Return an alist of (TYPE MATCH)."
(setq result (append result (widget-apply child :value-inline)))))
result))
+;; #### FIXME: should handle default value some day -- dvl
+(defun widget-checklist-prompt-value (widget prompt value unbound)
+ ;; Prompt for items to be selected, and the prompt for their value
+ (let* ((args (widget-get widget :args))
+ (choices (mapcar (lambda (elt)
+ (cons (widget-get elt :tag) elt))
+ args))
+ (continue t)
+ value)
+ (while continue
+ (setq continue (completing-read
+ (concat (widget-prompt-spaceify prompt)
+ "select [ret. when done]: ")
+ choices nil t))
+ (if (string= continue "")
+ (setq continue nil)
+ (push (widget-prompt-value (cdr (assoc continue choices))
+ prompt nil t)
+ value)))
+ (nreverse value)))
+
(defun widget-checklist-validate (widget)
;; Ticked children must be valid.
(let ((children (widget-get widget :children))
@@ -3116,6 +3168,7 @@ The parent of several `radio-button' wid
:value-delete 'widget-children-value-delete
:value-get 'widget-editable-list-value-get
:default-get 'widget-group-default-get
+:prompt-value 'widget-group-prompt-value
:validate 'widget-children-validate
:match 'widget-group-match
:match-inline 'widget-group-match-inline)
@@ -3146,6 +3199,36 @@ The parent of several `radio-button' wid
;; Get the default of the components.
(mapcar 'widget-default-get (widget-get widget :args)))
+(defun widget-group-prompt-value (widget prompt value unbound)
+ ;; Prompt in turn for every component of the group.
+ (let ((args (widget-get widget :args)))
+ (widget-apply
+ widget :value-to-external
+ (if unbound
+ (mapcar #'(lambda (arg)
+ (widget-prompt-value
+ arg
+ (concat (widget-prompt-spaceify prompt)
+ (widget-prompt arg nil ""))
+ nil t))
+ args)
+ ;; If VALUE is bound, the situation is a bit more complex because we
+ ;; have to split it into a list of default values for every child. Oh,
+ ;; boy, do I miss 'cl here... -- dvl
+ (let ((children args)
+ (defaults (widget-apply widget
+ :value-to-internal value))
+ child default result)
+ (while (setq child (pop children))
+ (setq default (pop defaults))
+ (push
+ (widget-prompt-value
+ child
+ (concat (widget-prompt-spaceify prompt)
+ (widget-prompt child nil ""))
+ default) result))
+ (nreverse result))))))
+
(defun widget-group-match (widget values)
;; Match if the components match.
(and (listp values)
@@ -3378,7 +3461,7 @@ link for that string."
(defun widget-sexp-prompt-value (widget prompt value unbound)
;; Read an arbitrary sexp.
- (let ((found (read-string prompt
+ (let ((found (read-string (concat prompt ": ")
(if unbound nil (cons (prin1-to-string value) 0))
(widget-get widget :prompt-history))))
(save-excursion
@@ -3502,8 +3585,8 @@ It will read a file name from the minibu
;; Read file from minibuffer.
(abbreviate-file-name
(if unbound
- (read-file-name prompt)
- (let ((prompt2 (format "%s (default %s) " prompt value))
+ (read-file-name (concat prompt ": "))
+ (let ((prompt2 (format "%s: (default %s) " prompt value))
(dir (file-name-directory value))
(file (file-name-nondirectory value))
(must-match (widget-get widget :must-match)))
@@ -3552,7 +3635,7 @@ It will read a directory name from the m
(defun widget-symbol-prompt-internal (widget prompt initial history)
;; Read file from minibuffer.
- (let ((answer (completing-read prompt obarray
+ (let ((answer (completing-read (concat prompt ": ") obarray
(widget-get widget :prompt-match)
nil initial history)))
(if (and (stringp answer)
@@ -3824,42 +3907,45 @@ Either the `:match' or the `:match-alter
(let ((args (widget-get widget :args))
(completion-ignore-case (widget-get widget :case-fold))
current choices old)
- ;; Find the first arg that matches VALUE.
- (let ((look args))
- (while look
- (if (widget-apply (car look) :match value)
- (setq old (car look)
- look nil)
- (setq look (cdr look)))))
- ;; Find new choice.
+ ;; Find the first choice matching VALUE (if given):
+ (unless unbound
+ (let ((look args))
+ (while look
+ (if (widget-apply (car look) :match value)
+ (setq old (car look)
+ look nil)
+ (setq look (cdr look)))))
+ ;; If VALUE is invalid (it doesn't match any choice), discard it by
+ ;; considering it unbound:
+ (unless old
+ (setq unbound t)))
+ ;; Now offer the choice, providing the given default value when/where
+ ;; appropriate:
+ (while args
+ (setq current (car args)
+ args (cdr args))
+ (setq choices
+ (cons (cons (widget-apply current :menu-tag-get)
+ current)
+ choices)))
(setq current
- (cond ((= (length args) 0)
- nil)
- ((= (length args) 1)
- (nth 0 args))
- ((and (= (length args) 2)
- (memq old args))
- (if (eq old (nth 0 args))
- (nth 1 args)
- (nth 0 args)))
- (t
- (while args
- (setq current (car args)
- args (cdr args))
- (setq choices
- (cons (cons (widget-apply current :menu-tag-get)
- current)
- choices)))
- (let ((val (completing-read prompt choices nil t)))
- (if (stringp val)
- (let ((try (try-completion val choices)))
- (when (stringp try)
- (setq val try))
- (cdr (assoc val choices)))
- nil)))))
+ (let ((val (completing-read (concat prompt ": ") choices nil t
+ (when old
+ (widget-apply old :menu-tag-get)))))
+ (if (stringp val) ;; #### is this really needed ? --dvl
+ (let ((try (try-completion val choices)))
+ (when (stringp try) ;; #### and this ? --dvl
+ (setq val try))
+ (cdr (assoc val choices)))
+ nil)))
(if current
- (widget-prompt-value current prompt nil t)
- value)))
+ (widget-prompt-value current
+ (concat (widget-prompt-spaceify prompt)
+ (widget-get current :tag))
+ (unless unbound
+ (when (eq current old) value))
+ (or unbound (not (eq current old))))
+ (and (not unbound) value))))
(define-widget 'radio 'radio-button-choice
"A set widget, selecting exactly one from many.
@@ -3891,7 +3977,7 @@ The parent of several `radio-button' wid
(defun widget-boolean-prompt-value (widget prompt value unbound)
;; Toggle a boolean.
- (y-or-n-p prompt))
+ (y-or-n-p (concat prompt ": ")))
;;; The `color' Widget.
@@ -4002,8 +4088,8 @@ Here we attempt to define my-list as a c
nil, or a cons-cell containing a sexp and my-lisp. This will not work
because the `choice' widget does not allow recursion.
-Using the `lazy' widget you can overcome this problem, as in this
-example:
+Using the `lazy' widget you can overcome this problem, as in this
+example:
(define-widget 'sexp-list 'lazy
\"A list of sexps.\"
@@ -4012,7 +4098,7 @@ example:
:format "%{%t%}: %v"
;; We don't convert :type because we want to allow recursive
;; datastructures. This is slow, so we should not create speed
- ;; critical widgets by deriving from this.
+ ;; critical widgets by deriving from this.
:convert-widget 'widget-value-convert-widget
:value-create 'widget-type-value-create
:value-delete 'widget-children-value-delete
@@ -4041,10 +4127,10 @@ Store the newly created widget in the :c
The value of the :type attribute should be an unconverted widget type."
(let ((value (widget-get widget :value))
(type (widget-get widget :type)))
- (widget-put widget :children
- (list (widget-create-child-value widget
- (widget-convert type)
- value)))))
+ (widget-put widget :children
+ (list (widget-create-child-value widget
+ (widget-convert type)
+ value)))))
(defun widget-type-default-get (widget)
"Get default value from the :type attribute of WIDGET.
1.25 +103 -103 XEmacs/xemacs/lisp/cus-edit.el
Index: cus-edit.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-edit.el,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -p -r1.24 -r1.25
--- cus-edit.el 2007/06/21 13:39:10 1.24
+++ cus-edit.el 2007/09/20 21:18:35 1.25
@@ -1,10 +1,11 @@
;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
;;
+;; Copyright (C) 2007 Didier Verna
+;; Copyright (C) 2003 Ben Wing
;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
-;; Copyright (C) 2003 Ben Wing.
;;
;; Author: Per Abrahamsen <abraham at dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic at xemacs.org>
+;; Maintainer: Didier Verna <didier at xemacs.org>
;; Keywords: help, faces
;; Version: 1.9960-x
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -306,7 +307,7 @@ Return a list suitable for use in `inter
(and (boundp symbol)
(or (get symbol 'custom-type)
(user-variable-p symbol))))
- t nil nil (and v (symbol-name v))))
+ t nil nil (and v (symbol-name v))))
(list (if (equal val "")
(if (symbolp v) v nil)
(intern val)))))
@@ -651,8 +652,8 @@ when the action is chosen.")
(defun custom-prompt-variable (prompt-var prompt-val &optional comment)
"Prompt for a variable and a value and return them as a list.
PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
-prompt for the value. The %s escape in PROMPT-VAL is replaced with
-the name of the variable.
+prompt for the value. A %s escape in PROMPT-VAL is replaced with
+the name of the variable. A final colon is appended to both prompts.
If the variable has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.
@@ -662,7 +663,7 @@ If the variable has a `custom-type' prop
If optional COMMENT argument is non nil, also prompt for a comment and return
it as the third element in the list."
- (let* ((var (read-variable prompt-var))
+ (let* ((var (read-variable (concat prompt-var ": ")))
(minibuffer-help-form '(describe-variable var))
(val
(let ((prop (get var 'variable-interactive))
@@ -683,12 +684,11 @@ it as the third element in the list."
(symbol-value var))
(not (boundp var))))
(t
- (eval-minibuffer prompt))))))
+ (eval-minibuffer (concat prompt ": ")))))))
(if comment
(list var val
(read-string "Comment: " (get var 'variable-comment)))
- (list var val))
- ))
+ (list var val))))
;;;###autoload
(defun customize-set-value (var val &optional comment)
@@ -701,8 +701,8 @@ If VARIABLE has a `custom-type' property
`:prompt-value' property of that widget will be used for reading the value.
If given a prefix (or a COMMENT argument), also prompt for a comment."
- (interactive (custom-prompt-variable "Set variable: "
- "Set %s to value: "
+ (interactive (custom-prompt-variable "Set variable"
+ "Set value of %s"
current-prefix-arg))
(set var val)
@@ -728,8 +728,8 @@ If VARIABLE has a `custom-type' property
`:prompt-value' property of that widget will be used for reading the value.
If given a prefix (or a COMMENT argument), also prompt for a comment."
- (interactive (custom-prompt-variable "Set variable: "
- "Set customized value for %s to: "
+ (interactive (custom-prompt-variable "Set variable"
+ "Set customized value of %s"
current-prefix-arg))
(funcall (or (get variable 'custom-set) 'set-default) variable value)
(put variable 'customized-value (list (custom-quote value)))
@@ -757,8 +757,8 @@ If VARIABLE has a `custom-type' property
`:prompt-value' property of that widget will be used for reading the value.
If given a prefix (or a COMMENT argument), also prompt for a comment."
- (interactive (custom-prompt-variable "Set and save variable: "
- "Set and save value for %s as: "
+ (interactive (custom-prompt-variable "Set and save variable"
+ "Set and save value of %s"
current-prefix-arg))
(funcall (or (get variable 'custom-set) 'set-default) variable value)
(put variable 'saved-value (list (custom-quote value)))
@@ -1770,7 +1770,7 @@ Backtrace follows:\n\n%s"
(return-from custom-load nil)))
#'(lambda ()
(load (expand-file-name "custom-defines" dir))))))
- ;; we get here only from the `return-from'; see above
+ ;; we get here only from the `return-from'; see above
(load source))))
(defun custom-load-widget (widget)
@@ -2545,7 +2545,7 @@ Match frames with dark backgrounds")
:sample-face 'custom-face-tag-face
:help-echo "Set or reset this face"
:documentation-property #'(lambda (face)
- (face-doc-string face))
+ (face-doc-string face))
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-category 'face
@@ -3496,40 +3496,40 @@ Leave the point at the end of the file."
(goto-char (point-min))
(condition-case nil
(while (not (eobp))
- (let ((sexp (read (current-buffer))))
- (when (and (listp sexp)
- (memq (car sexp) symbols))
- (delete-region (save-excursion
- (backward-sexp)
- (point))
- (point))
- (while (and (eolp) (not (eobp)))
- (delete-region (point) (prog2 (forward-line 1) (point))))
- )))
+ (let ((sexp (read (current-buffer))))
+ (when (and (listp sexp)
+ (memq (car sexp) symbols))
+ (delete-region (save-excursion
+ (backward-sexp)
+ (point))
+ (point))
+ (while (and (eolp) (not (eobp)))
+ (delete-region (point) (prog2 (forward-line 1) (point))))
+ )))
(end-of-file nil)))
(defsubst custom-save-variable-p (symbol)
"Return non-nil if symbol SYMBOL is a customized variable."
(and (symbolp symbol)
(let ((spec (car-safe (get symbol 'theme-value))))
- (or (and spec (eq (car spec) 'user)
- (eq (second spec) 'set))
- (get symbol 'saved-variable-comment)
- ;; support non-themed vars
- (and (null spec) (get symbol 'saved-value))))))
+ (or (and spec (eq (car spec) 'user)
+ (eq (second spec) 'set))
+ (get symbol 'saved-variable-comment)
+ ;; support non-themed vars
+ (and (null spec) (get symbol 'saved-value))))))
(defun custom-save-variable-internal (symbol)
"Print variable SYMBOL to the standard output.
SYMBOL must be a customized variable."
(let ((requests (get symbol 'custom-requests))
- (now (not (or (get symbol 'standard-value)
- (and (not (boundp symbol))
- (not (eq (get symbol 'force-value)
- 'rogue))))))
- (comment (get symbol 'saved-variable-comment))
- ;; Print everything, no placeholders `...'
- (print-level nil)
- (print-length nil))
+ (now (not (or (get symbol 'standard-value)
+ (and (not (boundp symbol))
+ (not (eq (get symbol 'force-value)
+ 'rogue))))))
+ (comment (get symbol 'saved-variable-comment))
+ ;; Print everything, no placeholders `...'
+ (print-level nil)
+ (print-length nil))
(unless (custom-save-variable-p symbol)
(error 'wrong-type-argument "Not a customized variable" symbol))
(princ "\n '(")
@@ -3540,10 +3540,10 @@ SYMBOL must be a customized variable."
;; (prin1 (third spec))
;; XEmacs -- pretty-print value if available
(if (and custom-save-pretty-print
- (fboundp 'pp))
- ;; To suppress bytecompiler warning
- (with-fboundp 'pp
- (pp (car (get symbol 'saved-value))))
+ (fboundp 'pp))
+ ;; To suppress bytecompiler warning
+ (with-fboundp 'pp
+ (pp (car (get symbol 'saved-value))))
(prin1 (car (get symbol 'saved-value))))
(when (or now requests comment)
(princ (if now " t" " nil")))
@@ -3570,21 +3570,21 @@ SYMBOL must be a customized variable."
(custom-save-loaded-themes)
(custom-save-resets 'theme-value 'custom-reset-variables nil)
(let ((standard-output (current-buffer))
- (sorted-list ()))
+ (sorted-list ()))
;; First create a sorted list of saved variables.
(mapatoms
- (lambda (symbol)
- (when (custom-save-variable-p symbol)
- (push symbol sorted-list))))
+ (lambda (symbol)
+ (when (custom-save-variable-p symbol)
+ (push symbol sorted-list))))
(setq sorted-list (sort sorted-list 'string<))
(unless (bolp)
- (princ "\n"))
+ (princ "\n"))
(princ "(custom-set-variables")
(mapc 'custom-save-variable-internal
- sorted-list)
+ sorted-list)
(princ ")")
(unless (looking-at "\n")
- (princ "\n")))))
+ (princ "\n")))))
(defvar custom-save-face-ignoring nil)
@@ -3593,14 +3593,14 @@ SYMBOL must be a customized variable."
(let ((theme-spec (car-safe (get symbol 'theme-face)))
(comment (get symbol 'saved-face-comment)))
(or (and (not (memq symbol custom-save-face-ignoring))
- ;; Don't print default face here.
- (or (and theme-spec
- (eq (car theme-spec) 'user)
- (eq (second theme-spec) 'set))
- ;; cope with non-themed faces
- (and (null theme-spec)
- (get symbol 'saved-face))))
- comment)))
+ ;; Don't print default face here.
+ (or (and theme-spec
+ (eq (car theme-spec) 'user)
+ (eq (second theme-spec) 'set))
+ ;; cope with non-themed faces
+ (and (null theme-spec)
+ (get symbol 'saved-face))))
+ comment)))
(defun custom-save-face-internal (symbol)
"Print face SYMBOL to the standard output.
@@ -3609,24 +3609,24 @@ SYMBOL must be a customized face."
(now (not (or (get symbol 'face-defface-spec)
(and (not (find-face symbol))
(not (eq (get symbol 'force-face) 'rogue))))))
- ;; Print everything, no placeholders `...'
- (print-level nil)
- (print-length nil))
+ ;; Print everything, no placeholders `...'
+ (print-level nil)
+ (print-length nil))
(if (memq symbol custom-save-face-ignoring)
- ;; Do nothing
- nil
+ ;; Do nothing
+ nil
;; Print face
(unless (custom-save-face-p symbol)
- (error 'wrong-type-argument "Not a customized face" symbol))
+ (error 'wrong-type-argument "Not a customized face" symbol))
(princ "\n '(")
(prin1 symbol)
(princ " ")
(prin1 (get symbol 'saved-face))
(if (or comment now)
- (princ (if now " t" " nil")))
+ (princ (if now " t" " nil")))
(when comment
- (princ " ")
- (prin1 comment))
+ (princ " ")
+ (prin1 comment))
(princ ")"))))
(defun custom-save-faces ()
@@ -3641,22 +3641,22 @@ SYMBOL must be a customized face."
;; 'custom-set-faces)
(custom-save-resets 'theme-face 'custom-reset-faces '(default))
(let ((standard-output (current-buffer))
- (sorted-list ()))
+ (sorted-list ()))
;; Create a sorted list of faces
(mapatoms
(lambda (symbol)
- (when (custom-save-face-p symbol)
- (push symbol sorted-list))))
+ (when (custom-save-face-p symbol)
+ (push symbol sorted-list))))
(setq sorted-list (sort sorted-list 'string<))
(unless (bolp)
(princ "\n"))
(princ "(custom-set-faces")
;; The default face must be first, since it affects the others.
(when (custom-save-face-p 'default)
- (custom-save-face-internal 'default))
+ (custom-save-face-internal 'default))
(let ((custom-save-face-ignoring '(default)))
(mapc 'custom-save-face-internal
- sorted-list))
+ sorted-list))
(princ ")")
(unless (looking-at "\n")
(princ "\n")))))
@@ -3665,35 +3665,35 @@ SYMBOL must be a customized face."
"Create a mapper for `custom-save-resets'."
`(lambda (object)
(let ((spec (car-safe (get object (quote ,property))))
- (print-level nil)
- (print-length nil))
+ (print-level nil)
+ (print-length nil))
(with-boundp '(ignored-special started-writing)
- (when (and (not (memq object ignored-special))
- (eq (car spec) 'user)
- (eq (second spec) 'reset))
- ;; Do not write reset statements unless necessary.
- (unless started-writing
- (setq started-writing t)
- (unless (bolp)
- (princ "\n"))
- (princ "(")
- (princ (quote ,setter))
- (princ "\n '(")
- (prin1 object)
- (princ " ")
- (prin1 (third spec))
- (princ ")")))))))
+ (when (and (not (memq object ignored-special))
+ (eq (car spec) 'user)
+ (eq (second spec) 'reset))
+ ;; Do not write reset statements unless necessary.
+ (unless started-writing
+ (setq started-writing t)
+ (unless (bolp)
+ (princ "\n"))
+ (princ "(")
+ (princ (quote ,setter))
+ (princ "\n '(")
+ (prin1 object)
+ (princ " ")
+ (prin1 (third spec))
+ (princ ")")))))))
(defconst custom-save-resets-mapper-alist
(eval-when-compile
(list (list 'theme-value 'custom-reset-variables
- (byte-compile
- (make-custom-save-resets-mapper
- 'theme-value 'custom-reset-variables)))
- (list 'theme-face 'custom-reset-faces
- (byte-compile
- (make-custom-save-resets-mapper
- 'theme-face 'custom-reset-faces)))))
+ (byte-compile
+ (make-custom-save-resets-mapper
+ 'theme-value 'custom-reset-variables)))
+ (list 'theme-face 'custom-reset-faces
+ (byte-compile
+ (make-custom-save-resets-mapper
+ 'theme-face 'custom-reset-faces)))))
"Never use it.
Hashes several heavily used functions for `custom-save-resets'")
@@ -3703,9 +3703,9 @@ Hashes several heavily used functions fo
;; (custom-save-delete setter) Done by caller
(let ((standard-output (current-buffer))
(mapper (let ((triple (assq property custom-save-resets-mapper-alist)))
- (if (and triple (eq (second triple) setter))
- (third triple)
- (make-custom-save-resets-mapper property setter)))))
+ (if (and triple (eq (second triple) setter))
+ (third triple)
+ (make-custom-save-resets-mapper property setter)))))
(mapc mapper special)
(setq ignored-special special)
(mapatoms mapper)
@@ -3716,8 +3716,8 @@ Hashes several heavily used functions fo
(defun custom-save-loaded-themes ()
(let ((themes (reverse (get 'user 'theme-loads-themes)))
(standard-output (current-buffer))
- (print-level nil)
- (print-length nil))
+ (print-level nil)
+ (print-length nil))
(when themes
(unless (bolp) (princ "\n"))
(princ "(custom-load-themes")
@@ -3910,7 +3910,7 @@ Complete content of editable text field.
Invoke button under point. \\[widget-button-press]
Set all modifications. \\[Custom-set]
Make all modifications default. \\[Custom-save]
-Reset all modified options. \\[Custom-reset-current]
+Reset all modified options. \\[Custom-reset-current]
Reset all modified or set options. \\[Custom-reset-saved]
Reset all options. \\[Custom-reset-standard]
More information about the XEmacs-CVS
mailing list