xemacs-beta: lisp/cus-edit.el comparison

comparison lisp/cus-edit.el @ 4178:e687f1912d5b

[xemacs-hg @ 2007-09-20 21:18:33 by didierv] User options interactive prompting improvements

author	didierv
date	Thu, 20 Sep 2007 21:18:35 +0000
parents	cef5f57bb9e2
children	ef6c55ab3090

comparison

equal deleted inserted replaced

-:d080fe09a356
+:e687f1912d5b
 ;;; 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@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; Keywords: help, faces
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 ;; This file is part of XEmacs.
 		  "Customize variable: ")
 		obarray (lambda (symbol)
 			  (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)))))
 ;; Here we take not only the actual groups, but the loads, too.
 ;;; The Customize Commands
 (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
+prompt for the value.  A %s escape in PROMPT-VAL is replaced with
-the name of the variable.
+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.
 If the variable has a `custom-type' property, it must be a widget and the
 `:prompt-value' property of that widget will be used for reading the value.
 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))
 		(type (get var 'custom-type))
 		(prompt (format prompt-val var)))
 					prompt
 					(if (boundp var)
 					    (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)
 "Set VARIABLE to VALUE.  VALUE is a Lisp object.
 If VARIABLE has a `custom-type' property, it must be a widget and the
 `: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: "
+(interactive (custom-prompt-variable "Set variable"
-				       "Set %s to value: "
+				       "Set value of %s"
 				       current-prefix-arg))
 (set var val)
 (cond ((string= comment "")
 	 (put var 'variable-comment nil))
 If VARIABLE has a `custom-type' property, it must be a widget and the
 `: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: "
+(interactive (custom-prompt-variable "Set variable"
-				       "Set customized value for %s to: "
+				       "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)))
 (cond ((string= comment "")
 	 (put variable 'variable-comment nil)
 If VARIABLE has a `custom-type' property, it must be a widget and the
 `: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: "
+(interactive (custom-prompt-variable "Set and save variable"
-				       "Set and save value for %s as: "
+				       "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)))
 (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
 (cond ((string= comment "")
 			   (backtrace-in-condition-handler-eliminating-handler
 			    '__custom_load_cd1__)))
 		     (return-from custom-load nil)))
 	       #'(lambda ()
 		   (load (expand-file-name "custom-defines" dir))))))
 ;; we get here only from the `return-from'; see above
 (load source))))
 (defun custom-load-widget (widget)
 "Load all dependencies for WIDGET."
 (custom-load-symbol (widget-value widget)))
 (define-widget 'custom-face 'custom
 "Customize face."
 :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
 :custom-form nil ; defaults to value of `custom-face-default-form'
 :custom-set 'custom-face-set
 	(auto-mode-alist nil))
 (set-buffer (find-file-noselect custom-file)))
 (goto-char (point-min))
 (condition-case nil
 (while (not (eobp))
-(let ((sexp (read (current-buffer))))
+	(let ((sexp (read (current-buffer))))
-(when (and (listp sexp)
+	  (when (and (listp sexp)
-(memq (car sexp) symbols))
+		     (memq (car sexp) symbols))
-(delete-region (save-excursion
+	    (delete-region (save-excursion
-(backward-sexp)
+			     (backward-sexp)
-(point))
+			     (point))
-(point))
+			   (point))
-(while (and (eolp) (not (eobp)))
+	    (while (and (eolp) (not (eobp)))
-(delete-region (point) (prog2 (forward-line 1) (point))))
+	      (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)
+	 (or (and spec (eq (car spec) 'user)
-(eq (second spec) 'set))
+		  (eq (second spec) 'set))
-(get symbol 'saved-variable-comment)
+	     (get symbol 'saved-variable-comment)
-;; support non-themed vars
+	     ;; support non-themed vars
-(and (null spec) (get symbol 'saved-value))))))
+	     (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)
+	(now (not (or (get symbol 'standard-value)
-(and (not (boundp symbol))
+		      (and (not (boundp symbol))
-(not (eq (get symbol 'force-value)
+			   (not (eq (get symbol 'force-value)
-'rogue))))))
+				    'rogue))))))
-(comment (get symbol 'saved-variable-comment))
+	(comment (get symbol 'saved-variable-comment))
-;; Print everything, no placeholders `...'
+	;; Print everything, no placeholders `...'
-(print-level nil)
+	(print-level nil)
-(print-length nil))
+	(print-length nil))
 (unless (custom-save-variable-p symbol)
 (error 'wrong-type-argument "Not a customized variable" symbol))
 (princ "\n '(")
 (prin1 symbol)
 (princ " ")
 ;; This comment stuff is in the way ####
 ;; Is (eq (third spec) (car saved-value)) ????
 ;; (prin1 (third spec))
 ;; XEmacs -- pretty-print value if available
 (if (and custom-save-pretty-print
-(fboundp 'pp))
+	     (fboundp 'pp))
-;; To suppress bytecompiler warning
+	;; To suppress bytecompiler warning
-(with-fboundp 'pp
+	(with-fboundp 'pp
-(pp (car (get symbol 'saved-value))))
+	  (pp (car (get symbol 'saved-value))))
 (prin1 (car (get symbol 'saved-value))))
 (when (or now requests comment)
 (princ (if now " t" " nil")))
 (when (or comment requests)
 (princ " ")
 ;;                        'custom-reset-variables
 ;;                        'custom-set-variables)
 (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)
+	(lambda (symbol)
-(when (custom-save-variable-p symbol)
+	  (when (custom-save-variable-p symbol)
-(push symbol sorted-list))))
+	    (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)
 (defsubst custom-save-face-p (symbol)
 "Return non-nil if SYMBOL is a customized face."
 (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.
+	     ;; Don't print default face here.
-(or (and theme-spec
+	     (or (and theme-spec
-(eq (car theme-spec) 'user)
+		      (eq (car theme-spec) 'user)
-(eq (second theme-spec) 'set))
+		      (eq (second theme-spec) 'set))
-;; cope with non-themed faces
+		 ;; cope with non-themed faces
-(and (null theme-spec)
+		 (and (null theme-spec)
-(get symbol 'saved-face))))
+		      (get symbol 'saved-face))))
-comment)))
+	comment)))
 (defun custom-save-face-internal (symbol)
 "Print face SYMBOL to the standard output.
 SYMBOL must be a customized face."
 (let ((comment (get symbol 'saved-face-comment))
 	(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 everything, no placeholders `...'
-(print-level nil)
+	(print-level nil)
-(print-length nil))
+	(print-length nil))
 (if (memq symbol custom-save-face-ignoring)
-;; Do nothing
+	;; Do nothing
-nil
+	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 " ")
+	(princ " ")
-(prin1 comment))
+	(prin1 comment))
 (princ ")"))))
 (defun custom-save-faces ()
 "Save all customized faces in `custom-file'."
 (save-excursion
 ;; a bad behavior <npak@ispras.ru>
 ;;(custom-save-delete-any 'custom-reset-faces
 ;;                        '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)
+	 (when (custom-save-face-p symbol)
-(push symbol sorted-list))))
+	   (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")))))
 (defmacro make-custom-save-resets-mapper (property setter)
 "Create a mapper for `custom-save-resets'."
 `(lambda (object)
 (let ((spec (car-safe (get object (quote ,property))))
-(print-level nil)
+	   (print-level nil)
-(print-length nil))
+	   (print-length nil))
 (with-boundp '(ignored-special started-writing)
-(when (and (not (memq object ignored-special))
+	 (when (and (not (memq object ignored-special))
-(eq (car spec) 'user)
+		    (eq (car spec) 'user)
-(eq (second spec) 'reset))
+		    (eq (second spec) 'reset))
-;; Do not write reset statements unless necessary.
+	   ;; Do not write reset statements unless necessary.
-(unless started-writing
+	   (unless started-writing
-(setq started-writing t)
+	     (setq started-writing t)
-(unless (bolp)
+	     (unless (bolp)
-(princ "\n"))
+	       (princ "\n"))
-(princ "(")
+	     (princ "(")
-(princ (quote ,setter))
+	     (princ (quote ,setter))
-(princ "\n '(")
+	     (princ "\n '(")
-(prin1 object)
+	     (prin1 object)
-(princ " ")
+	     (princ " ")
-(prin1 (third spec))
+	     (prin1 (third spec))
-(princ ")")))))))
+	     (princ ")")))))))
 (defconst custom-save-resets-mapper-alist
 (eval-when-compile
 (list (list 'theme-value 'custom-reset-variables
-(byte-compile
+		(byte-compile
-(make-custom-save-resets-mapper
+		 (make-custom-save-resets-mapper
-'theme-value 'custom-reset-variables)))
+		  'theme-value 'custom-reset-variables)))
-(list 'theme-face 'custom-reset-faces
+	  (list 'theme-face 'custom-reset-faces
-(byte-compile
+		(byte-compile
-(make-custom-save-resets-mapper
+		 (make-custom-save-resets-mapper
-'theme-face 'custom-reset-faces)))))
+		  'theme-face 'custom-reset-faces)))))
 "Never use it.
 Hashes several heavily used functions for `custom-save-resets'")
 (defun custom-save-resets (property setter special)
 (declare (special ignored-special))
 (let (started-writing ignored-special)
 ;; (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))
+		    (if (and triple (eq (second triple) setter))
-(third triple)
+			(third triple)
-(make-custom-save-resets-mapper property setter)))))
+		      (make-custom-save-resets-mapper property setter)))))
 (mapc mapper special)
 (setq ignored-special special)
 (mapatoms mapper)
 (when started-writing
 	(princ ")\n")))))
 (defun custom-save-loaded-themes ()
 (let ((themes (reverse (get 'user 'theme-loads-themes)))
 	(standard-output (current-buffer))
-(print-level nil)
+	(print-level nil)
-(print-length nil))
+	(print-length nil))
 (when themes
 (unless (bolp) (princ "\n"))
 (princ "(custom-load-themes")
 (mapc (lambda (theme)
 	      (princ "\n   '")
 Complete content of editable text field.   \\[widget-complete]
 \\<custom-mode-map>\
 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]
 Entry to this mode calls the value of `custom-mode-hook'
 if that value is non-nil."

Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 4178:e687f1912d5b