From: Mauro Aranda Date: Tue, 15 Aug 2023 22:35:39 +0000 (-0300) Subject: Specialize default-get for alist widgets (Bug#63290) X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fa9197fcb097ad0847c5955ac5ad50ca47826fe1;p=emacs.git Specialize default-get for alist widgets (Bug#63290) * lisp/wid-edit.el (widget-list-default-get) (widget-alist-default-get): New functions. (list, alist): Use it. * test/lisp/cus-edit-tests.el (cus-edit-test-bug63290-option) (cus-edit-test-bug63290-option-2): New test options. (cus-edit-test-bug63290): New test. * test/lisp/wid-edit-tests.el (widget-test-alist-default-value-1) (widget-test-alist-default-value-2) (widget-test-alist-default-value-3) (widget-test-alist-default-value-4): New tests. --- diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index fabf590f6b8..a70598bb6c9 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3801,8 +3801,19 @@ like the newline character or the tab character." (define-widget 'list 'group "A Lisp list." :tag "List" + :default-get #'widget-list-default-get :format "%{%t%}:\n%v") +(defun widget-list-default-get (widget) + "Return the default external value for a list WIDGET. + +The default value is the one stored in the :value property, even if it is nil, +or a list with the default value of each component of the list WIDGET." + (widget-apply widget :value-to-external + (if (widget-member widget :value) + (widget-get widget :value) + (widget-group-default-get widget)))) + (define-widget 'vector 'group "A Lisp vector." :tag "Vector" @@ -3931,7 +3942,6 @@ example: value-type widget-plist-value-type)) `(group :format "Key: %v" :inline t ,key-type ,value-type))) - ;;; The `alist' Widget. ;; ;; Association lists. @@ -3941,6 +3951,7 @@ example: :key-type '(sexp :tag "Key") :value-type '(sexp :tag "Value") :convert-widget 'widget-alist-convert-widget + :default-get #'widget-alist-default-get :tag "Alist") (defvar widget-alist-value-type) ;Dynamic variable @@ -3975,6 +3986,25 @@ example: (setq key-type `(const ,option) value-type widget-alist-value-type)) `(cons :format "Key: %v" ,key-type ,value-type))) + +(defun widget-alist-default-get (widget) + "Return the default value for WIDGET, an alist widget. + +The default value may be one of: +- The one stored in the :value property, even if it is nil. +- If WIDGET has options available, an alist consisting of the +default values for each option. +- nil, otherwise." + (widget-apply widget :value-to-external + (cond ((widget-member widget :value) + (widget-get widget :value)) + ((widget-get widget :options) + (mapcar #'widget-default-get + ;; Last one is the editable-list part, and + ;; we don't want those showing up as + ;; part of the default value. (Bug#63290) + (butlast (widget-get widget :args)))) + (t nil)))) (define-widget 'choice 'menu-choice "A union of several sexp types. diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index eca35d7c96a..3a788f19745 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -92,5 +92,48 @@ (buffer-substring-no-properties (point-min) (point-max))))) (should (string-search "Value `:foo' does not match type number" warn-txt)))) + +(defcustom cus-edit-test-bug63290-option nil + "Choice option for testing Bug#63290." + :type '(choice (alist + :key-type (string :tag "key") + :value-type (string :tag "value")) + (const :tag "auto" auto))) + +(defcustom cus-edit-test-bug63290-option2 'some + "Choice option for testing Bug#63290." + :type '(choice + (const :tag "some" some) + (alist + :key-type (string :tag "key") + :value-type (string :tag "value")))) + +(ert-deftest cus-edit-test-bug63290 () + "Test that changing a choice value back to an alist respects its nil value." + (customize-variable 'cus-edit-test-bug63290-option) + (search-forward "Value") + ;; Simulate changing the value. + (let* ((choice (widget-at)) + (args (widget-get choice :args)) + (list-opt (car (widget-get choice :children))) + (const-opt (nth 1 args))) + (widget-put choice :explicit-choice const-opt) + (widget-value-set choice (widget-default-get const-opt)) + (widget-put choice :explicit-choice list-opt) + (widget-value-set choice (widget-default-get list-opt))) + ;; No empty key/value pairs should show up. + (should-not (search-forward "key" nil t)) + (customize-variable 'cus-edit-test-bug63290-option2) + (search-forward "Value") + ;; Simulate changing the value. + (let* ((choice (widget-at)) + (args (widget-get choice :args)) + (const-opt (car (widget-get choice :children))) + (list-opt (nth 1 args))) + (widget-put choice :explicit-choice list-opt) + (widget-value-set choice (widget-default-get list-opt))) + ;; No empty key/value pairs should show up. + (should-not (search-forward "key" nil t))) + (provide 'cus-edit-tests) ;;; cus-edit-tests.el ends here diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index b379c7c91a8..ebfe729bc9a 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el @@ -349,4 +349,35 @@ return nil, even with a non-nil bubblep argument." (should-not (widget-apply widget :match "someundefinedcolorihope")) (should-not (widget-apply widget :match "#11223")))) +(ert-deftest widget-test-alist-default-value-1 () + "Test getting the default value for an alist widget with options." + (with-temp-buffer + (let ((w (widget-create '(alist :key-type string + :value-type integer + :options (("0" (integer))))))) + (should (equal '(("0" . 0)) (widget-default-get w)))))) + +(ert-deftest widget-test-alist-default-value-2 () + "Test getting the default value for an alist widget without :value." + (with-temp-buffer + (let ((w (widget-create '(alist :key-type string + :value-type integer)))) + (should-not (widget-default-get w))))) + +(ert-deftest widget-test-alist-default-value-3 () + "Test getting the default value for an alist widget with nil :value." + (with-temp-buffer + (let ((w (widget-create '(alist :key-type string + :value-type integer + :value nil)))) + (should-not (widget-default-get w))))) + +(ert-deftest widget-test-alist-default-value-4 () + "Test getting the default value for an alist widget with non-nil :value." + (with-temp-buffer + (let ((w (widget-create '(alist :key-type string + :value-type integer + :value (("1" . 1) ("2" . 2)))))) + (should (equal '(("1" . 1) ("2" . 2)) (widget-default-get w)))))) + ;;; wid-edit-tests.el ends here