X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fcus-edit.el;h=b27db594d252b9efbac4ddfba2397dd0124b2730;hb=e47437dbf7b5331e93c4a2c5de17a3544060d806;hp=897dd49b72549194463c731921b9271bc5b6f987;hpb=afa9772e3fcbb4e80e3e4cfd1a40b4fccc6d08b8;p=chise%2Fxemacs-chise.git- diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 897dd49..b27db59 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,6 +1,6 @@ ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. ;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Maintainer: Hrvoje Niksic @@ -55,6 +55,7 @@ (require 'cus-load) (require 'cus-start) +(require 'cus-file) ;; Huh? This looks dirty! (put 'custom-define-hook 'custom-type 'hook) @@ -303,7 +304,8 @@ Return a list suitable for use in `interactive'." obarray (lambda (symbol) (and (boundp symbol) (or (get symbol 'custom-type) - (user-variable-p symbol)))) t)) + (user-variable-p symbol)))) + t nil nil (and v (symbol-name v)))) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -399,7 +401,7 @@ This only has an effect when `custom-unlispify-tag-names' or (custom-unlispify-menu-entry symbol t))) (defun custom-prefix-add (symbol prefixes) - ;; Addd SYMBOL to list of ignored PREFIXES. + ;; Add SYMBOL to list of ignored PREFIXES. (cons (or (get symbol 'custom-prefix) (concat (symbol-name symbol) "-")) prefixes)) @@ -681,8 +683,8 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (put var 'variable-comment comment)))) ;;;###autoload -(defun customize-set-variable (var val &optional comment) - "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. +(defun customize-set-variable (variable value &optional comment) + "Set the default for VARIABLE to VALUE. VALUE is any Lisp object. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -700,18 +702,18 @@ 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: " current-prefix-arg)) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'customized-value (list (custom-quote val))) + (funcall (or (get variable 'custom-set) 'set-default) variable value) + (put variable 'customized-value (list (custom-quote value))) (cond ((string= comment "") - (put var 'variable-comment nil) - (put var 'customized-variable-comment nil)) + (put variable 'variable-comment nil) + (put variable 'customized-variable-comment nil)) (comment - (put var 'variable-comment comment) - (put var 'customized-variable-comment comment)))) + (put variable 'variable-comment comment) + (put variable 'customized-variable-comment comment)))) ;;;###autoload -(defun customize-save-variable (var val &optional comment) +(defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -729,15 +731,15 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set and ave variable: " "Set and save value for %s as: " current-prefix-arg)) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'saved-value (list (custom-quote val))) - (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val))) + (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 "") - (put var 'variable-comment nil) - (put var 'saved-variable-comment nil)) + (put variable 'variable-comment nil) + (put variable 'saved-variable-comment nil)) (comment - (put var 'variable-comment comment) - (put var 'saved-variable-comment comment))) + (put variable 'variable-comment comment) + (put variable 'saved-variable-comment comment))) (custom-save-all)) ;;;###autoload @@ -1033,7 +1035,6 @@ This works by calling the function specified by (widget-insert "\nOperate on everything in this buffer:\n ") (widget-create 'push-button :tag "Set" - :tag-glyph '("set-up" "set-down") :help-echo "\ Make your editing in this buffer take effect for this session" :action (lambda (widget &optional event) @@ -1041,7 +1042,6 @@ Make your editing in this buffer take effect for this session" (widget-insert " ") (widget-create 'push-button :tag "Save" - :tag-glyph '("save-up" "save-down") :help-echo "\ Make your editing in this buffer take effect for future Emacs sessions" :action (lambda (widget &optional event) @@ -1077,7 +1077,6 @@ Reset all values in this buffer to their standard settings" (widget-insert " ") (widget-create 'push-button :tag "Done" - :tag-glyph '("done-up" "done-down") :help-echo "Remove the buffer" :action (lambda (widget &optional event) (Custom-buffer-done))) @@ -1250,7 +1249,7 @@ item in another window.\n\n")) (defun custom-browse-insert-prefix (prefix) "Insert PREFIX. On XEmacs convert it to line graphics." - ;; ### Unfinished. + ;; #### Unfinished. (if nil ; (string-match "XEmacs" emacs-version) (progn (insert "*") @@ -1988,9 +1987,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (widget-put widget :custom-magic magic) (push magic buttons)) ;; Insert documentation. - ;; ### NOTE: this is ugly!!!! I need to do update the :buttons property + ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property ;; before the call to `widget-default-format-handler'. Otherwise, I - ;; loose my current `buttons'. This function shouldn't be called like + ;; lose my current `buttons'. This function shouldn't be called like ;; this anyway. The doc string widget should be added like the others. ;; --dv (widget-put widget :buttons buttons) @@ -2228,7 +2227,6 @@ Optional EVENT is the location for the menu." "Restore the saved value for the variable being edited by WIDGET." (let* ((symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default)) - (comment-widget (widget-get widget :comment-widget)) (value (get symbol 'saved-value)) (comment (get symbol 'saved-variable-comment))) (cond ((or value comment) @@ -2247,8 +2245,7 @@ Optional EVENT is the location for the menu." (defun custom-variable-reset-standard (widget) "Restore the standard setting for the variable being edited by WIDGET." (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - (comment-widget (widget-get widget :comment-widget))) + (set (or (get symbol 'custom-set) 'set-default))) (if (get symbol 'standard-value) (funcall set symbol (eval (car (get symbol 'standard-value)))) (signal 'error (list "No standard setting known for variable" symbol))) @@ -2275,7 +2272,7 @@ Optional EVENT is the location for the menu." :format "%t: %v" :tag "Attributes" :extra-offset 12 - :button-args '(:help-echo "Control whether this attribute have any effect") + :button-args '(:help-echo "Control whether this attribute has any effect") :args (mapcar (lambda (att) (list 'group :inline t @@ -2311,19 +2308,33 @@ OS/2 Presentation Manager") pm) (const :format "MSWindows " :sibling-args (:help-echo "\ -Windows NT/95/97") +Microsoft Windows, displays") mswindows) - (const :format "DOS " + (const :format "MSPrinter " :sibling-args (:help-echo "\ -Plain MS-DOS") - pc) +Microsoft Windows, printers") + msprinter) (const :format "TTY%n" :sibling-args (:help-echo "\ Plain text terminals") tty))) (group :sibling-args (:help-echo "\ +Only match display or printer devices") + (const :format "Output: " + class) + (checklist :inline t + :offset 0 + (const :format "Display " + :sibling-args (:help-echo "\ +Match display devices") + display) + (const :format "Printer%n" + :sibling-args (:help-echo "\ +Match printer devices") + printer))) + (group :sibling-args (:help-echo "\ Only match the frames with the specified color support") - (const :format "Class: " + (const :format "Color support: " class) (checklist :inline t :offset 0 @@ -2759,7 +2770,7 @@ Optional EVENT is the location for the menu." :tag "Hook") (defun custom-hook-convert-widget (widget) - ;; Handle `:custom-options'. + ;; Handle `:options'. (let* ((options (widget-get widget :options)) (other `(editable-list :inline t :entry-format "%i %d%v" @@ -3228,15 +3239,6 @@ Optional EVENT is the location for the menu." (widget-put widget :custom-state found))) (custom-magic-reset widget)) -;;; The `custom-save-all' Function. -;;;###autoload -(defcustom custom-file "~/.emacs" - "File used for storing customization information. -If you change this from the default \"~/.emacs\" you need to -explicitly load that file for the settings to take effect." - :type 'file - :group 'customize) - (defun custom-save-delete (symbol) "Delete the call to SYMBOL form in `custom-file'. Leave point at the location of the call, or after the last expression." @@ -3269,7 +3271,7 @@ Leave point at the location of the call, or after the last expression." (unless (bolp) (princ "\n")) (princ "(custom-set-variables") - (mapatoms (lambda (symbol) + (mapatoms (lambda (symbol) (let ((spec (car-safe (get symbol 'theme-value))) (requests (get symbol 'custom-requests)) (now (not (or (get symbol 'standard-value) @@ -3282,7 +3284,7 @@ Leave point at the location of the call, or after the last expression." (princ "\n '(") (prin1 symbol) (princ " ") - ;; This comment stuf is in the way #### + ;; This comment stuff is in the way #### ;; Is (eq (third spec) (car saved-value)) ???? ;; (prin1 (third spec)) (prin1 (car (get symbol 'saved-value))) @@ -3343,7 +3345,8 @@ Leave point at the location of the call, or after the last expression." (defun custom-save-resets (property setter special) (let (started-writing ignored-special) - ;; (custom-save-delete setter) Done by caller + (setq ignored-special ignored-special) ;; suppress byte-compiler warning + ;; (custom-save-delete setter) Done by caller (let ((standard-output (current-buffer)) (mapper `(lambda (object) (let ((spec (car-safe (get object (quote ,property))))) @@ -3366,8 +3369,9 @@ Leave point at the location of the call, or after the last expression." (setq ignored-special special) (mapatoms mapper) (when started-writing - (princ ")\n"))))) - + (princ ")\n")))) + ) + (defun custom-save-loaded-themes () (let ((themes (reverse (get 'user 'theme-loads-themes))) @@ -3378,7 +3382,7 @@ Leave point at the location of the call, or after the last expression." (mapc (lambda (theme) (princ "\n '") (prin1 theme)) themes) - (princ " )\n")))) + (princ " )\n")))) ;;;###autoload (defun customize-save-customized () @@ -3583,6 +3587,19 @@ if that value is non-nil." (run-hooks 'custom-mode-hook)) +;;;###autoload +(defun custom-migrate-custom-file (new-custom-file-name) + "Migrate custom file from home directory." + (mapc 'custom-save-delete + '(custom-load-themes custom-reset-variables + custom-set-variables + custom-set-faces + custom-reset-faces)) + (with-current-buffer (find-file-noselect custom-file) + (save-buffer)) + (setq custom-file new-custom-file-name) + (custom-save-all)) + ;;; The End. (provide 'cus-edit)