procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Specialize default-get for alist widgets (Bug#63290)

Browse source 
* 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.
This commit is contained in:
Mauro Aranda 2023-08-15 19:35:39 -03:00 • committed by Eli Zaretskii
parent cd3f163005
commit fa9197fcb0
3 changed files with 105 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lisp/wid-edit.el
View file

@ -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.

43
test/lisp/cus-edit-tests.el
View file

@ -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

31
test/lisp/wid-edit-tests.el
View file

@ -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