X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d488166820e1e38ca2d0cb03ced717b81dc2901c..fbc7bbf778f45d15ad29a454a1c728e4657043e4:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 50759537ec..ae4277ea09 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -36,9 +36,7 @@ (require 'cus-face) (require 'wid-edit) -(require 'easymenu) (eval-when-compile - (require 'cl) (defvar custom-versions-load-alist)) ; from cus-load (condition-case nil @@ -385,7 +383,6 @@ IF REGEXP is not a string, return it unchanged." regexp)) (defun custom-variable-prompt () - ;; Code stolen from `help.el'. "Prompt for a variable, defaulting to the variable at point. Return a list suitable for use in `interactive'." (let ((v (variable-at-point)) @@ -399,7 +396,7 @@ Return a list suitable for use in `interactive'." (and (boundp symbol) (or (get symbol 'custom-type) (get symbol 'custom-loads) - (user-variable-p symbol)))) t)) + (get symbol 'standard-value)))) t)) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -609,7 +606,7 @@ groups after non-groups, if nil do not order groups at all." (sort (copy-sequence items) (lambda (a b) (let ((typea (nth 1 a)) (typeb (nth 1 b)) - (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b)))) + (namea (nth 0 a)) (nameb (nth 0 b))) (cond ((not order-groups) ;; Since we don't care about A and B order, maybe sort. (when sort-alphabetically @@ -636,19 +633,19 @@ groups after non-groups, if nil do not order groups at all." "Set changes in all modified options." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) children))) (defun Custom-save () "Set all modified group members and save them." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-save))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (widget-apply child :custom-save))) children)) (custom-save-all)) @@ -674,22 +671,22 @@ when the action is chosen.") "Reset all modified group members to their current value." (interactive) (let ((children custom-options)) - (mapcar (lambda (widget) - (and (default-boundp (widget-value widget)) - (if (memq (widget-get widget :custom-state) - '(modified changed)) - (widget-apply widget :custom-reset-current)))) + (mapc (lambda (widget) + (and (default-boundp (widget-value widget)) + (if (memq (widget-get widget :custom-state) + '(modified changed)) + (widget-apply widget :custom-reset-current)))) children))) (defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) (let ((children custom-options)) - (mapcar (lambda (widget) - (and (get (widget-value widget) 'saved-value) - (if (memq (widget-get widget :custom-state) - '(modified set changed rogue)) - (widget-apply widget :custom-reset-saved)))) + (mapc (lambda (widget) + (and (get (widget-value widget) 'saved-value) + (if (memq (widget-get widget :custom-state) + '(modified set changed rogue)) + (widget-apply widget :custom-reset-saved)))) children))) (defun Custom-reset-standard (&rest ignore) @@ -699,11 +696,11 @@ This operation eliminates any saved settings for the group members, making them as if they had never been customized at all." (interactive) (let ((children custom-options)) - (mapcar (lambda (widget) - (and (get (widget-value widget) 'standard-value) - (if (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)) - (widget-apply widget :custom-reset-standard)))) + (mapc (lambda (widget) + (and (get (widget-value widget) 'standard-value) + (if (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)) + (widget-apply widget :custom-reset-standard)))) children))) ;;; The Customize Commands @@ -939,7 +936,11 @@ version." (interactive "sCustomize options changed, since version (default all versions): ") (if (equal since-version "") - (setq since-version nil)) + (setq since-version nil) + (unless (condition-case nil + (numberp (read since-version)) + (error nil)) + (signal 'wrong-type-argument (list 'numberp since-version)))) (unless since-version (setq since-version customize-changed-options-previous-release)) (let ((found nil) @@ -990,17 +991,24 @@ version." "*Customize Changed Options*")))) (defun customize-version-lessp (version1 version2) + ;; Why are the versions strings, and given that they are, why aren't + ;; they converted to numbers and compared as such here? -- fx + ;; In case someone made a mistake and left out the quotes ;; in the :version value. (if (numberp version2) (setq version2 (prin1-to-string version2))) (let (major1 major2 minor1 minor2) - (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1) - (setq major1 (read (match-string 1 version1))) - (setq minor1 (read (match-string 2 version1))) - (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2) - (setq major2 (read (match-string 1 version2))) - (setq minor2 (read (match-string 2 version2))) + (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version1) + (setq major1 (read (or (match-string 1 version1) + "0"))) + (setq minor1 (read (or (match-string 3 version1) + "0"))) + (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version2) + (setq major2 (read (or (match-string 1 version2) + "0"))) + (setq minor2 (read (or (match-string 3 version2) + "0"))) (or (< major1 major2) (and (= major1 major2) (< minor1 minor2))))) @@ -1287,10 +1295,20 @@ Un-customize all values in this buffer. They get their standard settings." (widget-insert " ") (widget-create 'push-button :tag "Finish" - :help-echo "Bury or kill the buffer." + :help-echo + (lambda (&rest ignore) + (concat (cond + ((eq custom-buffer-done-function + 'custom-bury-buffer) + "Bury") + ((eq custom-buffer-done-function 'kill-buffer) + "Kill") + (t "Finish with")) + " the buffer.")) :action #'Custom-buffer-done) (widget-insert "\n\n") (message "Creating customization items...") + (buffer-disable-undo) (setq custom-options (if (= (length options) 1) (mapcar (lambda (entry) @@ -1320,9 +1338,10 @@ Un-customize all values in this buffer. They get their standard settings." (widget-insert "\n")) (message "Creating customization items ...%2d%%done" 100) (unless (eq custom-buffer-style 'tree) - (mapcar 'custom-magic-reset custom-options)) + (mapc 'custom-magic-reset custom-options)) (message "Creating customization setup...") (widget-setup) + (buffer-enable-undo) (goto-char (point-min)) (message "Creating customization buffer...done")) @@ -1687,9 +1706,11 @@ and `face'." (defface custom-button-face '((((type x) (class color)) ; Like default modeline - (:box (:line-width 2 :style released-button) :background "lightgrey")) + (:box (:line-width 2 :style released-button) + :background "lightgrey" :foreground "black")) (((type w32) (class color)) ; Like default modeline - (:box (:line-width 2 :style released-button) :background "lightgrey")) + (:box (:line-width 2 :style released-button) + :background "lightgrey" :foreground "black")) (t nil)) "Face used for buttons in customization buffers." @@ -1698,9 +1719,11 @@ and `face'." (defface custom-button-pressed-face '((((type x) (class color)) - (:box (:line-width 2 :style pressed-button) :background "lightgrey")) + (:box (:line-width 2 :style pressed-button) + :background "lightgrey" :foreground "black")) (((type w32) (class color)) - (:box (:line-width 2 :style pressed-button) :background "lightgrey")) + (:box (:line-width 2 :style pressed-button) + :background "lightgrey" :foreground "black")) (t (:inverse-video t))) "Face used for buttons in customization buffers." @@ -2400,7 +2423,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) @@ -2421,8 +2443,7 @@ Optional EVENT is the location for the menu." This operation eliminates any saved setting for the variable, restoring it to the state of a variable that has never been customized." (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)))) (error "No standard setting known for %S" symbol)) @@ -2547,8 +2568,7 @@ Match frames with dark backgrounds.") "Customize face." :sample-face 'custom-face-tag-face :help-echo "Set or reset this face." - :documentation-property '(lambda (face) - (face-doc-string face)) + :documentation-property #'face-doc-string :value-create 'custom-face-value-create :action 'custom-face-action :custom-category 'face @@ -2889,7 +2909,7 @@ restoring it to the state of a face that has never been customized." :value-get 'widget-value-value-get :validate 'widget-children-validate :action 'widget-face-action - :match '(lambda (widget value) (symbolp value))) + :match (lambda (widget value) (symbolp value))) (defun widget-face-value-create (widget) "Create a `custom-face' child." @@ -3274,7 +3294,7 @@ Creating group members... %2d%%" (widget-insert "\n")))) members))) (message "Creating group magic...") - (mapcar 'custom-magic-reset children) + (mapc 'custom-magic-reset children) (message "Creating group state...") (widget-put widget :children children) (custom-group-state-update widget) @@ -3327,42 +3347,42 @@ Optional EVENT is the location for the menu." (defun custom-group-set (widget) "Set changes in all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) children ))) (defun custom-group-save (widget) "Save all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-save))) children ))) (defun custom-group-reset-current (widget) "Reset all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-reset-current))) children ))) (defun custom-group-reset-saved (widget) "Reset all modified or set group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-reset-saved))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-reset-saved))) children ))) (defun custom-group-reset-standard (widget) "Reset all modified, set, or saved group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set saved)) - (widget-apply child :custom-reset-standard))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set saved)) + (widget-apply child :custom-reset-standard))) children ))) (defun custom-group-state-update (widget) @@ -3623,20 +3643,11 @@ or (if there were none) at the end of the buffer." ':style 'toggle ':selected symbol))) -;; Fixme: sort out use of :filter in Emacs 21. -(if nil ; (string-match "XEmacs" emacs-version) - ;; XEmacs can create menus dynamically. - (defun custom-group-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization group SYMBOL." - `( ,(custom-unlispify-menu-entry symbol t) - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) - ;; But emacs can't. - (defun custom-group-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization group SYMBOL." - ;; Limit the nesting. - (let ((custom-menu-nesting (1- custom-menu-nesting))) - (custom-menu-create symbol)))) +(defun custom-group-menu-create (widget symbol) + "Ignoring WIDGET, create a menu entry for customization group SYMBOL." + `( ,(custom-unlispify-menu-entry symbol t) + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;;;###autoload (defun custom-menu-create (symbol) @@ -3673,14 +3684,9 @@ Otherwise the menu will be named `Customize'. The format is suitable for use with `easy-menu-define'." (unless name (setq name "Customize")) - ;; Fixme: sort out use of :filter in Emacs 21. - (if nil ;(string-match "XEmacs" emacs-version) - ;; We can delay it under XEmacs. - `(,name - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol)))) - ;; But we must create it now under Emacs. - (cons name (cdr (custom-menu-create symbol))))) + `(,name + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;;; The Custom Mode.