Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 4744:17f7e9191c0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rationalise duplicated functionality, #'custom-quote, #'quote-maybe. src/ChangeLog addition: 2009-11-15 Aidan Kehoe <kehoea@parhasard.net> * eval.c (Fquote_maybe): Move this function here from callint.c; make it more comprehensive about which types are self-quoting. * lisp.h: Declare Fquote_maybe here, since it's now used in callint.c and defined in eval.c * callint.c (Fquote_maybe): Remove this function from this file. lisp/ChangeLog addition: 2009-11-15 Aidan Kehoe <kehoea@parhasard.net> * custom.el (custom-quote): Define this as an alias for `quote-maybe', which is in C and more comprehensive; packages still use this name in places. (customize-mark-to-save, customize-mark-as-set): Use `quote-maybe', not `custom-quote'. * cus-edit.el (customize-set-variable, customize-save-variable) (custom-variable-value-create, custom-variable-set) (custom-variable-pre-save): Remove a version of `custom-quote' specific to this file; use `quote-maybe' universally instead.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 15 Nov 2009 14:59:53 +0000
parents 684f0ed6cd4f
children fd36a980d701
comparison
equal deleted inserted replaced
4743:776bbf454f3a 4744:17f7e9191c0b
266 "Mule XEmacs internationalization." 266 "Mule XEmacs internationalization."
267 :group 'i18n) 267 :group 'i18n)
268 268
269 269
270 ;;; Utilities. 270 ;;; Utilities.
271
272 (defun custom-quote (sexp)
273 "Quote SEXP iff it is not self quoting."
274 (if (or (memq sexp '(t nil))
275 (keywordp sexp)
276 (eq (car-safe sexp) 'lambda)
277 (stringp sexp)
278 (numberp sexp)
279 (characterp sexp)
280 (vectorp sexp)
281 (bit-vector-p sexp))
282 sexp
283 (list 'quote sexp)))
284 271
285 (defun custom-split-regexp-maybe (regexp) 272 (defun custom-split-regexp-maybe (regexp)
286 "If REGEXP is a string, split it to a list at `\\|'. 273 "If REGEXP is a string, split it to a list at `\\|'.
287 You can get the original back with from the result with: 274 You can get the original back with from the result with:
288 (mapconcat #'identity result \"\\|\") 275 (mapconcat #'identity result \"\\|\")
730 If given a prefix (or a COMMENT argument), also prompt for a comment." 717 If given a prefix (or a COMMENT argument), also prompt for a comment."
731 (interactive (custom-prompt-variable "Set variable" 718 (interactive (custom-prompt-variable "Set variable"
732 "Set customized value of %s" 719 "Set customized value of %s"
733 current-prefix-arg)) 720 current-prefix-arg))
734 (funcall (or (get variable 'custom-set) 'set-default) variable value) 721 (funcall (or (get variable 'custom-set) 'set-default) variable value)
735 (put variable 'customized-value (list (custom-quote value))) 722 (put variable 'customized-value (list (quote-maybe value)))
736 (cond ((string= comment "") 723 (cond ((string= comment "")
737 (put variable 'variable-comment nil) 724 (put variable 'variable-comment nil)
738 (put variable 'customized-variable-comment nil)) 725 (put variable 'customized-variable-comment nil))
739 (comment 726 (comment
740 (put variable 'variable-comment comment) 727 (put variable 'variable-comment comment)
759 If given a prefix (or a COMMENT argument), also prompt for a comment." 746 If given a prefix (or a COMMENT argument), also prompt for a comment."
760 (interactive (custom-prompt-variable "Set and save variable" 747 (interactive (custom-prompt-variable "Set and save variable"
761 "Set and save value of %s" 748 "Set and save value of %s"
762 current-prefix-arg)) 749 current-prefix-arg))
763 (funcall (or (get variable 'custom-set) 'set-default) variable value) 750 (funcall (or (get variable 'custom-set) 'set-default) variable value)
764 (put variable 'saved-value (list (custom-quote value))) 751 (put variable 'saved-value (list (quote-maybe value)))
765 (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value))) 752 (custom-push-theme 'theme-value variable 'user 'set (list (quote-maybe value)))
766 (cond ((string= comment "") 753 (cond ((string= comment "")
767 (put variable 'variable-comment nil) 754 (put variable 'variable-comment nil)
768 (put variable 'saved-variable-comment nil)) 755 (put variable 'saved-variable-comment nil))
769 (comment 756 (comment
770 (put variable 'variable-comment comment) 757 (put variable 'variable-comment comment)
2110 (let* ((value (cond ((get symbol 'saved-value) 2097 (let* ((value (cond ((get symbol 'saved-value)
2111 (car (get symbol 'saved-value))) 2098 (car (get symbol 'saved-value)))
2112 ((get symbol 'standard-value) 2099 ((get symbol 'standard-value)
2113 (car (get symbol 'standard-value))) 2100 (car (get symbol 'standard-value)))
2114 ((default-boundp symbol) 2101 ((default-boundp symbol)
2115 (custom-quote (funcall get symbol))) 2102 (quote-maybe (funcall get symbol)))
2116 (t 2103 (t
2117 (custom-quote (widget-get conv :value)))))) 2104 (quote-maybe (widget-get conv :value))))))
2118 (insert (symbol-name symbol) ": ") 2105 (insert (symbol-name symbol) ": ")
2119 (push (widget-create-child-and-convert 2106 (push (widget-create-child-and-convert
2120 widget 'visibility 2107 widget 'visibility
2121 :help-echo "Hide the value of this option" 2108 :help-echo "Hide the value of this option"
2122 :action 'custom-toggle-parent 2109 :action 'custom-toggle-parent
2351 (setq comment nil) 2338 (setq comment nil)
2352 ;; Make the comment invisible by hand if it's empty 2339 ;; Make the comment invisible by hand if it's empty
2353 (set-extent-property (widget-get comment-widget :comment-extent) 2340 (set-extent-property (widget-get comment-widget :comment-extent)
2354 'invisible t)) 2341 'invisible t))
2355 (funcall set symbol (setq val (widget-value child))) 2342 (funcall set symbol (setq val (widget-value child)))
2356 (put symbol 'customized-value (list (custom-quote val))) 2343 (put symbol 'customized-value (list (quote-maybe val)))
2357 (put symbol 'variable-comment comment) 2344 (put symbol 'variable-comment comment)
2358 (put symbol 'customized-variable-comment comment))) 2345 (put symbol 'customized-variable-comment comment)))
2359 (custom-variable-state-set widget) 2346 (custom-variable-state-set widget)
2360 (custom-redraw-magic widget))) 2347 (custom-redraw-magic widget)))
2361 2348
2391 (setq comment nil) 2378 (setq comment nil)
2392 ;; Make the comment invisible by hand if it's empty 2379 ;; Make the comment invisible by hand if it's empty
2393 (set-extent-property (widget-get comment-widget :comment-extent) 2380 (set-extent-property (widget-get comment-widget :comment-extent)
2394 'invisible t)) 2381 'invisible t))
2395 (put symbol 2382 (put symbol
2396 'saved-value (list (custom-quote (widget-value 2383 'saved-value (list (quote-maybe (widget-value
2397 child)))) 2384 child))))
2398 (custom-push-theme 'theme-value symbol 'user 2385 (custom-push-theme 'theme-value symbol 'user
2399 'set (list (custom-quote (widget-value 2386 'set (list (quote-maybe (widget-value
2400 child)))) 2387 child))))
2401 (funcall set symbol (widget-value child)) 2388 (funcall set symbol (widget-value child))
2402 (put symbol 'variable-comment comment) 2389 (put symbol 'variable-comment comment)
2403 (put symbol 'saved-variable-comment comment))) 2390 (put symbol 'saved-variable-comment comment)))
2404 (put symbol 'customized-value nil) 2391 (put symbol 'customized-value nil)
2405 (put symbol 'customized-variable-comment nil) 2392 (put symbol 'customized-variable-comment nil)