From 6001bb3826e1ec084dcd8ba15b3cb03d83c0f2f9 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sat, 5 Sep 2020 19:06:06 -0300 Subject: [PATCH] Show tag of options and groups unlispified, keep lispified names underneath * lisp/cus-edit.el (custom-unlispify-tag-name): Add an optional argument, to control whether to add a 'display text property to the returned string. With this, Custom can display the tag as an unlispified name of an user option or a group, while keeping the lispified name in the buffer, so commands like describe-variable can pick it up as the default value. (Bug#41905) (Bug#400) (custom-buffer-create-internal, customize-browse) (custom-add-parent-links, custom-group-value-create): Change the call to custom-unlispify-tag-name accordingly, since now we pass a propertized string as the :tag value of the widget. * test/lisp/custom-test.el (custom-test-unlispify-tag-name-propertizing): New test, to test for this feature. --- lisp/cus-edit.el | 28 ++++++++++++++++++---------- test/lisp/custom-tests.el | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 10 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 7153ba40e1..06622631f7 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -568,10 +568,18 @@ custom-unlispify-tag-names :group 'custom-buffer :type 'boolean) -(defun custom-unlispify-tag-name (symbol) - "Convert SYMBOL into a menu entry." - (let ((custom-unlispify-menu-entries custom-unlispify-tag-names)) - (custom-unlispify-menu-entry symbol t))) +(defun custom-unlispify-tag-name (symbol &optional propertizep) + "Return a string representing SYMBOL as a tag name. + +With PROPERTIZEP non-nil, the string that represents SYMBOL has a 'display text +property whose value is the return value of `custom-unlispify-menu-entry'. +The value of the 'display text property depends on the user option +`custom-unlispify-tag-names'." + (let* ((custom-unlispify-menu-entries custom-unlispify-tag-names) + (str (custom-unlispify-menu-entry symbol t))) + (if propertizep + (propertize (symbol-name symbol) 'display str) + str))) (defun custom-prefix-add (symbol prefixes) "Add SYMBOL to list of ignored PREFIXES." @@ -1708,7 +1716,7 @@ custom-buffer-create-internal :documentation-shown t :custom-state 'unknown :tag (custom-unlispify-tag-name - (nth 0 entry)) + (nth 0 entry) t) :value (nth 0 entry))) options) (let ((count 0) @@ -1719,7 +1727,7 @@ custom-buffer-create-internal (floor (* 100.0 count) length)) (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name - (nth 0 entry)) + (nth 0 entry) t) :value (nth 0 entry)) (setq count (1+ count)) (unless (eq (preceding-char) ?\n) @@ -1781,7 +1789,7 @@ customize-browse (widget-create 'custom-group :custom-last t :custom-state 'unknown - :tag (custom-unlispify-tag-name group) + :tag (custom-unlispify-tag-name group t) :value group)) (widget-setup) (goto-char (point-min))) @@ -2355,7 +2363,7 @@ custom-add-parent-links (insert " ") (push (widget-create-child-and-convert widget 'custom-group-link - :tag (custom-unlispify-tag-name symbol) + :tag (custom-unlispify-tag-name symbol t) symbol) buttons) (setq parents (cons symbol parents))))) @@ -4174,7 +4182,7 @@ custom-group-value-create (push (widget-create-child-and-convert widget (nth 1 entry) :group widget - :tag (custom-unlispify-tag-name (nth 0 entry)) + :tag (custom-unlispify-tag-name (nth 0 entry) t) :custom-prefixes custom-prefix-list :custom-level (1+ level) :custom-last (null members) @@ -4297,7 +4305,7 @@ custom-group-value-create (push (widget-create-child-and-convert widget type :group widget - :tag (custom-unlispify-tag-name sym) + :tag (custom-unlispify-tag-name sym t) :custom-prefixes custom-prefix-list :custom-level (1+ level) :value sym) diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 7853c84bb6..d061315714 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -145,4 +145,37 @@ custom-test-show-comment-preserves-changes (widget-apply field :value-to-internal origvalue) "bar")))))) +(ert-deftest custom-test-unlispify-tag-name-propertizing () + "Test that propertizing tag name for variables and faces works as intended." + ;; Customize a group that has a dash. + ;; The buffer name should have the group name unlispified. + (customize-group 'custom-browse) + (should (string= (buffer-name) "*Customize Group: Custom Browse*")) + ;; Advance to the group tag. + (search-forward (get 'custom-browse 'group-documentation)) + (beginning-of-line) + ;; The display property should be the group name unlispified. + (should (string= (get-text-property (point) 'display) "Custom Browse")) + ;; And we should be able to detect a symbol at point, the group name, + ;; lispified. + (should (eq (symbol-at-point) 'custom-browse)) + + ;; We use the first user option, for testing. + (let ((w (car (widget-get (car custom-options) :children)))) + ;; The symbol name should be the same string stored in :tag, not counting + ;; text properties. + (should (string= (symbol-name (widget-get w :value)) + (widget-get w :tag))) + ;; And the 'display text property should be the unlispified symbol name. + (should (string= (custom-unlispify-tag-name (widget-get w :value)) + (get-text-property 0 'display (widget-get w :tag))))) + + ;; Now try with a face. + (customize-face 'scroll-bar) + (let ((w (car custom-options))) + (should (string= (symbol-name (widget-get w :value)) + (widget-get w :tag))) + (should (string= (custom-unlispify-tag-name (widget-get w :value)) + (get-text-property 0 'display (widget-get w :tag)))))) + ;;; custom-tests.el ends here -- 2.28.0