custom type `color' is not enforced

custom type `color' is not enforced

[Drew Adams]

emacs -Q

(defcustom foo "White" "xxxxxxx" :type (quote color))

M-x customize-variable foo

In Customize, change the value to "any-non-color-string". You are able
to set the new value and even save it. There is no check done that the
value is actually a color - any string will do. The value should be
checked to ensure that it matches either a defined color name or "#"
followed by a multiple of three hex digits (for RGB).


In GNU Emacs 22.1.1 (i386-mingw-nt5.1.2600)
 of 2007-06-02 on RELEASE
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --cflags -Ic:/gnuwin32/include'

RE: custom type `color' is not enforced

[Drew Adams]

Similarly, a variable declared to be of type `regexp' should have its value
tested to ensure that it is a valid regexp. Currently, any string is
accepted.

> emacs -Q
>
> (defcustom foo "White" "xxxxxxx" :type (quote color))
>
> M-x customize-variable foo
>
> In Customize, change the value to "any-non-color-string". You are able
> to set the new value and even save it. There is no check done that the
> value is actually a color - any string will do. The value should be
> checked to ensure that it matches either a defined color name or "#"
> followed by a multiple of three hex digits (for RGB).
>
>
> In GNU Emacs 22.1.1 (i386-mingw-nt5.1.2600)
>  of 2007-06-02 on RELEASE
> Windowing system distributor `Microsoft Corp.', version 5.1.2600
> configured using `configure --with-gcc (3.4) --cflags
> -Ic:/gnuwin32/include'
>
>

RE: custom type `color' is not enforced

[Drew Adams]

> From: Drew Adams Sent: Sunday, December 02, 2007 1:00 AM
> > emacs -Q
> > (defcustom foo "White" "xxxxxxx" :type (quote color))
> > M-x customize-variable foo
> >
> > In Customize, change the value to "any-non-color-string". You are able
> > to set the new value and even save it. There is no check done that the
> > value is actually a color - any string will do. The value should be
> > checked to ensure that it matches either a defined color name or "#"
> > followed by a multiple of three hex digits (for RGB).
>
> > Similarly, a variable declared to be of type `regexp' should have
> > its value tested to ensure that it is a valid regexp. Currently,
> > any string is accepted.
> >
> > In GNU Emacs 22.1.1 (i386-mingw-nt5.1.2600) of 2007-06-02 on RELEASE
> > Windowing system distributor `Microsoft Corp.', version 5.1.2600
> > configured using `configure --with-gcc (3.4) --cflags
> > -Ic:/gnuwin32/include'

I sent that to bug-gnu-emacs a little while ago (no response yet). Copying
it to emacs-devel, with some additional motivating info.

The `color' type, in particular, should be easy to test (either the string
is in the list of color names or it satisfies `#' followed by three groups
of hex digits).

Type `regexp' might be more difficult to test, but that too should be
possible, since we issue invalid-regexp errors for strings that aren't valid
regexps.

I hope this bug (missing feature) will be fixed. Types are powerful and
useful. They let you categorize and filter options.

I am also interested in this missing feature because I think the fix would
likely provide some type-checking code that I could use in other places.

I have, for instance, a command `describe-option-of-type' (which I bind to
`C-h M-o'). It is similar to `describe-variable', but it lets you use
defcustom types to narrow the set of completion candidates. I found no
existing code that handles subtyping and type equivalence, so I just made it
handle an exact type match for now, by default. But with `C-u' it also
includes as candidates options whose current values are compatible with the
specified type.

`C-h M-o color RET TAB' correctly gives all options defined with :type
`color' (rigid equality test). However, since Emacs currently does not
distinguish type `color' from type `string' (= this bug), `C-u C-h M-o'
color RET TAB' gives all string-valued variables as candidates. It would be
nice if only legitimate color-valued candidates were available for
completion. Similarly, for type `regexp'.

FWIW, so you can see what I mean and in case Emacs is interested in it, this
is my definition of the command:

(defun describe-option-of-type (type variable)
  "Describe an Emacs user VARIABLE (option) of a given TYPE.
VARIABLE is defined with `defcustom' type TYPE.

With a prefix argument, either VARIABLE is defined with `defcustom'
type TYPE or its current value is compatible with TYPE.

If TYPE is nil (default value) then all `defcustom' variables are
potential candidates.  That is different from using `describe-option',
because `describe-option' includes user-variable candidates not
defined with `defcustom' (with `*'-prefixed doc strings)."
  (interactive
   (let* ((symb (and (symbolp (variable-at-point))
                     (variable-at-point)))
          (typ
           (car
            (condition-case err
                (read-from-string
                 (let ((types ()))
                   (mapatoms
                    (lambda (cand)
                      (when (custom-variable-p cand)
                        (push
                         (list
                          (format
                           "%s"
                           (format "%S" (get cand 'custom-type))))
                         types))))
                   (completing-read "Describe option of type: "
                                    (help-remove-duplicates types)
                                    nil nil nil nil "nil")))
              (end-of-file (error "No such custom type")))))
          (pref-arg current-prefix-arg))
     (list typ
           (intern
            (completing-read
             "Option: " obarray
             (lambda (var)
               (and (custom-variable-p var)
                    (or (not typ)       ; All vars if type = nil.
                        (if pref-arg
                            (help-var-is-of-type-p var (list typ))
                          (equal (get var 'custom-type) typ)))))
             t nil nil (and symb (symbol-name symb)) t)))))
  (describe-variable variable nil t))

(defun help-var-is-of-type-p (variable types)
  "Return non-nil if VARIABLE is of one of the custom types in TYPES.
Non-nil means either VARIABLE's custom type is a member of list TYPES
or VARIABLE is bound and its value satisfies a type in list TYPES."
  (or (memq (get variable 'custom-type) types)
      (and (boundp variable)
           (let ((val (symbol-value variable)))
             (catch 'help-type-matches
               (dolist (type types)
                 (setq type (widget-convert type))
                 (when (widget-apply type :match val)
                   (throw 'help-type-matches t)))
               nil)))))

Re: custom type `color' is not enforced

[Richard Stallman]

    The `color' type, in particular, should be easy to test (either the string
    is in the list of color names or it satisfies `#' followed by three groups
    of hex digits).

    Type `regexp' might be more difficult to test, but that too should be
    possible, since we issue invalid-regexp errors for strings that aren't valid
    regexps.

I agree that these changes would be improvements.  However, I don't
think we have any way to test the validity of a regexp without
matching it, and matching it (even against a null string) could
cause an infinite loop.

    I have, for instance, a command `describe-option-of-type' (which I bind to
    `C-h M-o'). It is similar to `describe-variable', but it lets you use
    defcustom types to narrow the set of completion candidates.

I have to say it doesn't sound tremendously useful.

    `C-h M-o color RET TAB' correctly gives all options defined with :type
    `color' (rigid equality test). However, since Emacs currently does not
    distinguish type `color' from type `string' (= this bug),

That statement surprises me.  The two types have different names, and
don't behave the same, so in what sense does Emacs not distinguish
them?

Re: custom type `color' is not enforced

[Lennart Borgman (gmail)]

Richard Stallman wrote:
> I agree that these changes would be improvements.  However, I don't
> think we have any way to test the validity of a regexp without
> matching it, and matching it (even against a null string) could
> cause an infinite loop.

The widget library already validates

   :type 'regexp

with the function (defun widget-regexp-validate (widget) ... ) which 
does (string-match regexp "").

Re: custom type `color' is not enforced

[Richard Stallman]

    with the function (defun widget-regexp-validate (widget) ... ) which 
    does (string-match regexp "").

Maybe that does work.  I just tried a regexp with nested loops,
"\\(\\(\\W?\\)*\\)*", and it returned immediately, which sure
surprised me.  Not only that, it returned immediately in re-search-forward
with a nonempty buffer, which surprised me even more.

RE: custom type `color' is not enforced

[Drew Adams]

>     The `color' type, in particular, should be easy to test
>     (either the string is in the list of color names or it
>     satisfies `#' followed by three groups of hex digits).
>
>     Type `regexp' might be more difficult to test, but that too should be
>     possible, since we issue invalid-regexp errors for strings
>     that aren't valid regexps.
>
> I agree that these changes would be improvements.  However, I don't
> think we have any way to test the validity of a regexp without
> matching it, and matching it (even against a null string) could
> cause an infinite loop.

That could be, but `color' should be doable, at least. There might also be
other such type checks that could be done but are not.

>     I have, for instance, a command `describe-option-of-type'
>     (which I bind to `C-h M-o'). It is similar to `describe-variable',
>     but it lets you use defcustom types to narrow the set of
>     completion candidates.
>
> I have to say it doesn't sound tremendously useful.

I have to say "lack of imagination". ;-)

Don't assume that the user knows just which option s?he wants to describe.
`describe-variable' gives you only one way, by option name, to define a set
of candidate options, in order to pick one to describe. You can type a
prefix and hit TAB to see what the matching options are, but when there are
many with the same prefix that doesn't help much. You need to scan the list
looking for what might be the appropriate option, and some of the names in
the list might not be very suggestive. That can mean a lot of parsing and
thinking energy.

Obviously, with substring (not just prefix) matching, finding the right
option to describe is easier - you can match, say, `width' anywhere in the
option name, not just as a prefix. And if you can also match multiple
substrings, without regard to order, so much the better.

But you are still relying on only the option name, which (1) is not
necessarily efficient (there can still be many such matches) and (2) might
not work at all: you might not be thinking in terms of the same words that
are used in the option name.

Adding the ability to specify the option type increases your matching power
and thus your expressiveness and efficiency as a user.

For example, you might know that you want to examine or modify some
integer-valued option that controls how many chars are used for something.
You can try strings such as `char', `min', and `width' in the option name,
and you can also make it match the prefix `icicle-' to limit the search to
options in one package, but you will still be fishing in the dark to some
extent. Being able to also say that you know that the option is an integer
can narrow things down considerably.

Or suppose the option you are after is `Info-prefer-subnodes', and you can't
remember the name. You might be thinking in terms of `space', `menu',
`submenu', `depth-first', `navigate', and `traversal', but not in terms of
`subnode'. Matching against the `Info-' options gives you twice as many
candidates as matching against the `Info-' options that are boolean.

Same thing for other options where there are many with the same prefix and
the option name might not use terms you are thinking of - boolean options
`imenu-eager-completion-buffer' and `inverse-video', for example.

Similarly, if you want to customize an option, you can use
`customize-apropos-options', but you can often narrow things down better if
you use `customize-apropos-options-of-type' (another command I can offer).

>     `C-h M-o color RET TAB' correctly gives all options defined with :type
>     `color' (rigid equality test). However, since Emacs currently does not
>     distinguish type `color' from type `string' (= this bug),
>
> That statement surprises me.  The two types have different names, and
> don't behave the same, so in what sense does Emacs not distinguish
> them?

Please reread what I said: it _correctly_ gives all options defined with
`color', using a rigid equality test for the type. Where it breaks down is
"this bug": the fact that any string as the option value satisfies type
`color'.

The part you didn't quote explains this: Using `C-u' with `C-h M-o' tests
whether the current value of an option satisfies (is compatible with) type
`color' (in this case). And any string at all is deemed by Emacs to be of
type `color'. That's the missing feature or bug. If you don't use `C-u',
then you get a rigid equality test for the type, and that works OK, as far
as it goes.

`help-var-is-of-type-p' is the part of the code that `C-u' uses to test
whether the value is of the right type:

 (widget-apply (widget-convert type):match value)

And any string VALUE at all satisfies this test when TYPE is `color',
`string', or `regexp'.

The ability to look for options whose value is of the right type (i.e., via
`C-u' here) is all the more important in that there is not yet any treatment
of type comparison (beyond a rigid :type comparison with `equal') or of
subtyping (a `regexp' is a `string'; an `integer' is a `number').

With substring matching and using `C-u' with `C-h M-o', I can see candidate
options whose current value satisfies a `type' definition that includes
"string" - that means type definitions such as these:

(choice (string :tag "Show candidate plus a WYSIWYG swatch with text..."
                :value "MMMM")
        (const :tag "Show candidate itself using WYSIWYG" t)
        (const :tag "Show candidate as is, with no text properties" nil))

(repeat (list string (choice (const :tag "None" nil) (string :tag "Match
regexp")) (choice (const :tag "None" nil) (string :tag "No-match regexp"))
(choice (const :tag "None" nil) (function :tag "Predicate")) (choice (const
:tag "None" nil) (repeat (string :tag "Extra buffer"))) (choice (const :tag
"None" nil) (function :tag "Sort function"))))

RE: custom type `color' is not enforced

[Drew Adams]

I wrote:

> With substring matching and using `C-u' with `C-h M-o', I can see
> candidate options whose current value satisfies a `type'
> definition that includes "string" - that means type definitions
> such as these:
>
> (choice (string :tag "Show candidate plus a WYSIWYG swatch with text..."
>                 :value "MMMM")
>         (const :tag "Show candidate itself using WYSIWYG" t)
>         (const :tag "Show candidate as is, with no text properties" nil))
>
> (repeat (list string (choice (const :tag "None" nil) (string :tag
> "Match regexp")) (choice (const :tag "None" nil) (string :tag
> "No-match regexp")) (choice (const :tag "None" nil) (function
> :tag "Predicate")) (choice (const :tag "None" nil) (repeat
> (string :tag "Extra buffer"))) (choice (const :tag "None" nil)
> (function :tag "Sort function"))))

Sorry; I mistakenly sent that before I was ready. My new Dell Latitude 620
has a glitch that it randomly flips into a mode where either Shift or
Control is automatically on, so, for instance, hitting the `s' key really
does `S' or `C-s'. Aggravating, and downright risky sometimes.

Anyway, I meant to format that last part:

(repeat
 (list string
       (choice (const :tag "None" nil)
               (string :tag "Match regexp"))
       (choice (const :tag "None" nil)
               (string :tag "No-match regexp"))
       (choice (const :tag "None" nil)
               (function :tag "Predicate"))
       (choice (const :tag "None" nil)
               (repeat (string :tag "Extra buffer")))
       (choice (const :tag "None" nil)
               (function :tag "Sort function"))))

And I meant to point out that a type def that simply includes "string"
somewhere is not necessarily a type def that uses type `string' as one of
its components ("string" might be in a :tag string, for instance). IOW, this
isn't a substitute for being able to check subtypes and aggregation type
components.

Re: custom type `color' is not enforced

[Richard Stallman]

    Don't assume that the user knows just which option s?he wants to describe.
    `describe-variable' gives you only one way, by option name, to define a set
    of candidate options, in order to pick one to describe.

I'm not assuming that.  Rather, I don't think very many people
would take the trouble to remember that `describe-option-of-type'
exists.  Thus, practically speaking it would not be very useful.

RE: custom type `color' is not enforced

[Drew Adams]

>     Don't assume that the user knows just which option s?he wants
>     to describe. `describe-variable' gives you only one way, by
>     option name, to define a set of candidate options, in order
>     to pick one to describe.
>
> I'm not assuming that.  Rather, I don't think very many people
> would take the trouble to remember that `describe-option-of-type'
> exists.  Thus, practically speaking it would not be very useful.

It needs a binding, yes. Not very many people would have learned or would
remember several of the help commands if they were not bound.

FWIW, in my code, I use these bindings in `help-map':

`o'   for `describe-option'  (= `describe-variable' with prefix arg)
`C-o' for `describe-option-of-type'
`c'   for `describe-command' (= `describe-function' with prefix arg)

(`describe-key-briefly' is `C-c'.)

Re: custom type `color' is not enforced

[Richard Stallman]

    >     `C-h M-o color RET TAB' correctly gives all options defined with :type
    >     `color' (rigid equality test). However, since Emacs currently does not
    >     distinguish type `color' from type `string' (= this bug),
    >
    > That statement surprises me.  The two types have different names, and
    > don't behave the same, so in what sense does Emacs not distinguish
    > them?

    Please reread what I said:

You said Emacs does not distinguish type `color' from type `string'.
That's mistaken; it does distinguish them.  They behave differently.

I agree it would be good to make `color' check for a valid color.
I hope someone will do that.

RE: custom type `color' is not enforced

[Drew Adams]

>     >     `C-h M-o color RET TAB' correctly gives all options
>     >     defined with :type `color' (rigid equality test).
>     >     However, since Emacs currently does not
>     >     distinguish type `color' from type `string' (= this bug),
>     >
>     > That statement surprises me.  The two types have different
>     > names, and don't behave the same, so in what sense does
>     > Emacs not distinguish them?
>
>     Please reread what I said:
>
> You said Emacs does not distinguish type `color' from type `string'.
> That's mistaken; it does distinguish them.

You continue to omit the part where I explained what I meant by that. If you
want to argue about what I said, and you think that omitting the explanation
helps you win the argument, go ahead; you win.

That's like me quoting your current statement only partially: You said
"Emacs does not distinguish type". Yes, you said those words, but that's not
really what you were saying. Taking words out of context is not
constructive.

My point (from the beginning; = what I described as "this bug") was that
there is a sense in which those types are not distinguished. I explained
twice what that sense was, what I meant by the insufficient type
distinction. If you don't want to see my point, fine.

> They behave differently.

Yes, if you compare only the symbols `color' and `string', they do behave
differently. If `get-custom-type' is the only yardstick, then they are
totally different, unrelated types.

> I agree it would be good to make `color' check for a valid color.
> I hope someone will do that.

So do I.

Re: custom type `color' is not enforced

[Lennart Borgman (gmail)]

Richard Stallman wrote:
>     >     `C-h M-o color RET TAB' correctly gives all options defined with :type
>     >     `color' (rigid equality test). However, since Emacs currently does not
>     >     distinguish type `color' from type `string' (= this bug),
>     >
>     > That statement surprises me.  The two types have different names, and
>     > don't behave the same, so in what sense does Emacs not distinguish
>     > them?
> 
>     Please reread what I said:
> 
> You said Emacs does not distinguish type `color' from type `string'.
> That's mistaken; it does distinguish them.  They behave differently.
> 
> I agree it would be good to make `color' check for a valid color.
> I hope someone will do that.


Something like this?


(defun color-digits-p (color)
   (save-match-data
     (string-match (rx bos
                       "#"
                       (or (repeat 3 3 hex-digit)
                           (repeat 6 6 hex-digit))
                       eos)
                   color
                   )))

(defun widget-color-validate (widget)
   (let ((val (widget-value widget)))
     (unless (or
              ;;(color-defined-p val)
              (member val x-colors)
              (and (stringp val)
                   (color-digits-p val)))
       (widget-put widget :error (format "Invalid color: %S"
                                         (widget-value widget)))
       widget)))

(define-widget 'color 'editable-field
   "Choose a color name (with sample)."
   :format "%{%t%}: %v (%{sample%})\n"
   :size 10
   :tag "Color"
   :validate 'widget-color-validate
   :value "black"
   :complete 'widget-color-complete
   :sample-face-get 'widget-color-sample-face-get
   :notify 'widget-color-notify
   :action 'widget-color-action)

(defcustom test-color "black"
   "color test"
   :type 'color)

RE: custom type `color' is not enforced

[Drew Adams]

> > I agree it would be good to make `color' check for a valid color.
> > I hope someone will do that.
>
> Something like this?
> (defun color-digits-p (color)
>    (save-match-data
>      (string-match (rx bos "#"
>                        (or (repeat 3 3 hex-digit)
>                            (repeat 6 6 hex-digit))
>                        eos)
>                    color)))
> (defun widget-color-validate (widget)
>    (let ((val (widget-value widget)))
>      (unless (or (member val x-colors)
>                  (and (stringp val)
>                       (color-digits-p val)))
>        (widget-put widget :error (format "Invalid color: %S"
>                                          (widget-value widget)))
>        widget)))
> (define-widget 'color 'editable-field
>    "Choose a color name (with sample)."
>    :format "%{%t%}: %v (%{sample%})\n"
>    :size 10
>    :tag "Color"
>    :validate 'widget-color-validate
>    :value "black"
>    :complete 'widget-color-complete
>    :sample-face-get 'widget-color-sample-face-get
>    :notify 'widget-color-notify
>    :action 'widget-color-action)
>
> (defcustom test-color "black" "color test" :type 'color)

Thanks, Lennart!

However:

- (defined-colors) should perhaps be used in place of `x-colors'.

- `color-digits-p' doesn't work for some legitimate colors, such as
"#FFFF0000FFFF". Any number of hex digits is legitimate, as long as it is a
multiple of 3 (RGB). FWIW, I use this regexp to check for an RGB string:

 "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$"

- Perhaps :size should be a bit larger? Some color names are longer than 10
chars. But I see that you took that and the rest of the `color' widget
definition from wid-edit.el: 10 is used in the Emacs definition of the
`color' widget.


Trying your fix made me realize that my type test was insufficient. I don't
understand widgets very well.

Instead of testing (widget-apply type :match val), it looks like I need to
test (and var-widget (not (widget-apply var-widget :validate))), where
var-widget is (get var 'custom-variable).

Here is what I use now; it seems to work (but suggestions are welcome). When
combined with your fix, it correctly distinguishes options whose values are
colors from those with arbitrary string values.

(defun help-var-is-of-type-p (variable types)
  "Return non-nil if VARIABLE is of one of the custom types in TYPES.
Non-nil means either VARIABLE's custom type is a member of list TYPES
or VARIABLE is bound and its value satisfies a type in list TYPES."
  (or (memq (get variable 'custom-type) types)
      (and (boundp variable)
           (let ((val (symbol-value variable))
                 (var-widget (get variable 'custom-variable)))
             (catch 'help-type-matches
               (dolist (type types)
                 (setq type (widget-convert type))
                 (when (and var-widget
                       (not (widget-apply var-widget :validate)))
                   (throw 'help-type-matches t)))
               nil)))))

So `C-u C-h C-o' (my `describe-option-of-type') now shows, as completion
candidates, all options whose values are legitimate colors (and no others).

RE: custom type `color' is not enforced

[Drew Adams]

I wrote:

> Trying your fix made me realize that my type test was
> insufficient. I don't understand widgets very well.

That last part is certainly true!

> Instead of testing (widget-apply type :match val), it looks like I need to
> test (and var-widget (not (widget-apply var-widget :validate))), where
> var-widget is (get var 'custom-variable).

Not quite. The code I sent didn't work. This seems to work, however:

(defun help-var-is-of-type-p (variable types)
  "Return non-nil if VARIABLE is of one of the custom types in TYPES.
Non-nil means either VARIABLE's custom type is a member of list TYPES
or VARIABLE is bound and its value satisfies a type in list TYPES."
  (or (memq (get variable 'custom-type) types)
      (and (boundp variable)
           (let ((val (symbol-value variable))
                 (var-widget (widget-convert (get variable 'custom-type))))
             (catch 'help-type-matches
               (dolist (type types)
                 (setq type (widget-convert type))
                 (plist-put (cdr type) :value val)
                 (when (and var-widget
                            (not (widget-apply type :validate)))
                   (throw 'help-type-matches t)))
               nil)))))

[I also had to modify Lennart's `color-digits-p' to use a regexp such as
what I sent earlier: "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$".]

There may be a simpler way to do it, but this seems to work OK.

> So `C-u C-h C-o' (my `describe-option-of-type') now shows, as completion
> candidates, all options whose values are legitimate colors (and
> no others).

That was not true when I wrote it, but it seems to be true now, with the
above code.

With C-u, `describe-option-of-type' `color' includes non-`color' options
whose values are legitimate for type `color'. That means that
`help-var-is-of-type-p' must return non-nil when passed an option whose
defcustom type is `string' but whose current value is "white" (and when
passed '(color) as the TYPES arg). And the same thing, generalized for all
types. And `help-var-is-of-type-p' also returns non-nil when testing an
option of type `color' or `regexp' for type `string'.

Re: custom type `color' is not enforced

[Richard Stallman]

You have the right idea.

Re: custom type `color' is not enforced

[Lennart Borgman (gmail)]

[-- Attachment #1: Type: text/plain, Size: 828 bytes --]

Richard Stallman wrote:
> You have the right idea.

I have tried to finish the code too now ;-)

Please see the attached files. Beside a more complete widget type for 
colors I have also included some basic functions for testing custom 
types. I believe these could be useful.

I have tried to make them as clean and simple as they can be at the 
moment. However I am unsure about how to call the :match and :validate 
functions. I might very well be missing something concerning the 
conversion from and to external values.

BTW when I have been looking at this I have had a hard time to 
understand why there are both :match and :validate functions.

I also do not understand the paramters they take. Why do the :match 
function have a widget parameter? Does it have something to do with 
external - internal conversion, or?


[-- Attachment #2: color-test.el --]
[-- Type: text/plain, Size: 4004 bytes --]


(defun color-digits-p (color)
  (save-match-data
    (string-match (rx bos
                      "#"
                      (1+ (repeat 3 3 hex-digit))
                      eos)
                  color)))

(defun widget-color-match (widget value)
  (or
   ;; I am not sure what colors to test. It might be relevant to check
   ;; all as I suggest here.
   ;;(color-defined-p val)
   (member value x-colors)
   (and (stringp value)
        (color-digits-p value))))

(defun widget-color-validate (widget)
  (let ((value (widget-value widget)))
    (unless (widget-color-match widget value)
      (widget-put widget :error (format "Invalid color: %S" value))
      widget)))

(define-widget 'color 'editable-field
  "Choose a color (with sample)."
  :format "%{%t%}: %v (%{sample%})\n"
  :size 25  ;; (length "light coldenrod yellow") = 22
  :tag "Color"
  :match 'widget-color-match
  :validate 'widget-color-validate
  :value "black"
  :complete 'widget-color-complete
  :sample-face-get 'widget-color-sample-face-get
  :notify 'widget-color-notify
  :action 'widget-color-action)

(defun custom-type-symbol-p (symbol custom-type)
  "Return t if value of symbol SYMBOL should fit CUSTOM-TYPE."
  (let ((found nil)
        (type (get symbol 'custom-type)))
    (while (and (not found) type)
      (setq found (eq type custom-type))
      (setq type (car (get type 'widget-type))))
    found))

(defun custom-type-value-p (value custom-type)
  "Return non-nil if value of VALUE fits CUSTOM-TYPE."
  (let ((widget (if (listp custom-type)
                    custom-type
                  (list custom-type))))
    (setq widget (widget-convert widget))
    ;; There are (unfortunately) two different ways to test the
    ;; values in a widget. Some widget types use both, some just one
    ;; of them. We check for both, but only use one of them here.
    (let ((match-fun (widget-get widget :match))
          (validate-fun (widget-get widget :validate)))
      ;;(setq match-fun nil)
      ;;(setq validate-fun nil)
      (widget-put widget :value value)
      ;; Fix-me: I am not sure whether widget-apply of funcall
      ;; should be used here, but I believe anyone of them can be
      ;; used. But please look into this. It might have something to
      ;; do with internal/external values for the widgets.
      (cond
       ;; Test the :match alternative first because this because this
       ;; seems most basic.
       (match-fun
        (when
            ;;(widget-apply widget :match value)
            (funcall match-fun widget value)
          t))
       (validate-fun
        (let (;;(val (widget-apply widget :validate))
              (val (funcall validate-fun widget)))
          ;; Check if :error was applied
          (when (not (widget-get val :error)) t)))
       (t
        (error
         "There is no way to check value against custom type %s"
         custom-type))))))

(defun custom-type-p (val-or-sym custom-type)
  "Return non-nil if VAL-OR-SYM fits CUSTOM-TYPE.
VAL-OR-SYM may be either a variable or a symbol. If it is a
variable then return non-nil if the value fits custom type
CUSTOM-TYPE.

If it is a symbol then return non-nil if the values this symbol's
variable can have fits CUSTOM-TYPE."
  (if (symbolp val-or-sym)
      (custom-type-symbol-p val-or-sym custom-type)
    (custom-type-value-p val-or-sym custom-type)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tests

;; (custom-type-p 'test-color 'color)
;; (custom-type-p 'test-color 'edit)
;; (custom-type-p 'test-color 'editable-field)
;; (custom-type-p test-color 'color)
;; (get 'test-color 'custom-type)
;; (setq test-color "bla")
;; (setq test-color "black")

(defcustom test-color "black"
  "color test"
  :type 'color)

(defun max-color-length()
  (let ((len 0)
        (longest ""))
    (mapc (lambda (color)
            (when (< len (length color))
              (setq len (length color))
              (setq longest color)))
          x-colors)
    (cons len longest)))
;; (max-color-length)

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

Re: custom type `color' is not enforced

[Per Abrahamsen]

From my unreliable memory:

The :validate function exist to check that the value the user has
entered in the widget actually match the "type" of the widget.  If the
user enter "kurt" in the editable text for an integer widget, validate
will signal an error.

The :match function exist to choose when "branch" to take for a choice
widget, and a few similar situations:  E.g. if you instantiate a
(choice integer string) type with the initial value of "kurt", the
second branch of the choice should be activated.  The logic of the
:match widget can be quite complex with composite wdgets, in fact the
whole mechanism is regular expressions over the "alphabet" of sexps.
Or should have been, had it been done right, the actual implementation
is somewhat weaker.

The :match function takes the widget as an argument, because sometimes
whether or not it matches depends on the widget properties.  For
example, the choice widget above will match strings and integers, but
another choice widget with other arguments will match other values.

-- Per

On 12/22/07, Lennart Borgman (gmail) <lennart.borgman@gmail.com> wrote:
> Richard Stallman wrote:
> > You have the right idea.
>
> I have tried to finish the code too now ;-)
>
> Please see the attached files. Beside a more complete widget type for
> colors I have also included some basic functions for testing custom
> types. I believe these could be useful.
>
> I have tried to make them as clean and simple as they can be at the
> moment. However I am unsure about how to call the :match and :validate
> functions. I might very well be missing something concerning the
> conversion from and to external values.
>
> BTW when I have been looking at this I have had a hard time to
> understand why there are both :match and :validate functions.
>
> I also do not understand the paramters they take. Why do the :match
> function have a widget parameter? Does it have something to do with
> external - internal conversion, or?
>
>
>
> (defun color-digits-p (color)
>  (save-match-data
>    (string-match (rx bos
>                      "#"
>                      (1+ (repeat 3 3 hex-digit))
>                      eos)
>                  color)))
>
> (defun widget-color-match (widget value)
>  (or
>   ;; I am not sure what colors to test. It might be relevant to check
>   ;; all as I suggest here.
>   ;;(color-defined-p val)
>   (member value x-colors)
>   (and (stringp value)
>        (color-digits-p value))))
>
> (defun widget-color-validate (widget)
>  (let ((value (widget-value widget)))
>    (unless (widget-color-match widget value)
>      (widget-put widget :error (format "Invalid color: %S" value))
>      widget)))
>
> (define-widget 'color 'editable-field
>  "Choose a color (with sample)."
>  :format "%{%t%}: %v (%{sample%})\n"
>  :size 25  ;; (length "light coldenrod yellow") = 22
>  :tag "Color"
>  :match 'widget-color-match
>  :validate 'widget-color-validate
>  :value "black"
>  :complete 'widget-color-complete
>  :sample-face-get 'widget-color-sample-face-get
>  :notify 'widget-color-notify
>  :action 'widget-color-action)
>
> (defun custom-type-symbol-p (symbol custom-type)
>  "Return t if value of symbol SYMBOL should fit CUSTOM-TYPE."
>  (let ((found nil)
>        (type (get symbol 'custom-type)))
>    (while (and (not found) type)
>      (setq found (eq type custom-type))
>      (setq type (car (get type 'widget-type))))
>    found))
>
> (defun custom-type-value-p (value custom-type)
>  "Return non-nil if value of VALUE fits CUSTOM-TYPE."
>  (let ((widget (if (listp custom-type)
>                    custom-type
>                  (list custom-type))))
>    (setq widget (widget-convert widget))
>    ;; There are (unfortunately) two different ways to test the
>    ;; values in a widget. Some widget types use both, some just one
>    ;; of them. We check for both, but only use one of them here.
>    (let ((match-fun (widget-get widget :match))
>          (validate-fun (widget-get widget :validate)))
>      ;;(setq match-fun nil)
>      ;;(setq validate-fun nil)
>      (widget-put widget :value value)
>      ;; Fix-me: I am not sure whether widget-apply of funcall
>      ;; should be used here, but I believe anyone of them can be
>      ;; used. But please look into this. It might have something to
>      ;; do with internal/external values for the widgets.
>      (cond
>       ;; Test the :match alternative first because this because this
>       ;; seems most basic.
>       (match-fun
>        (when
>            ;;(widget-apply widget :match value)
>            (funcall match-fun widget value)
>          t))
>       (validate-fun
>        (let (;;(val (widget-apply widget :validate))
>              (val (funcall validate-fun widget)))
>          ;; Check if :error was applied
>          (when (not (widget-get val :error)) t)))
>       (t
>        (error
>         "There is no way to check value against custom type %s"
>         custom-type))))))
>
> (defun custom-type-p (val-or-sym custom-type)
>  "Return non-nil if VAL-OR-SYM fits CUSTOM-TYPE.
> VAL-OR-SYM may be either a variable or a symbol. If it is a
> variable then return non-nil if the value fits custom type
> CUSTOM-TYPE.
>
> If it is a symbol then return non-nil if the values this symbol's
> variable can have fits CUSTOM-TYPE."
>  (if (symbolp val-or-sym)
>      (custom-type-symbol-p val-or-sym custom-type)
>    (custom-type-value-p val-or-sym custom-type)))
>
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;; Tests
>
> ;; (custom-type-p 'test-color 'color)
> ;; (custom-type-p 'test-color 'edit)
> ;; (custom-type-p 'test-color 'editable-field)
> ;; (custom-type-p test-color 'color)
> ;; (get 'test-color 'custom-type)
> ;; (setq test-color "bla")
> ;; (setq test-color "black")
>
> (defcustom test-color "black"
>  "color test"
>  :type 'color)
>
> (defun max-color-length()
>  (let ((len 0)
>        (longest ""))
>    (mapc (lambda (color)
>            (when (< len (length color))
>              (setq len (length color))
>              (setq longest color)))
>          x-colors)
>    (cons len longest)))
> ;; (max-color-length)
>
>

Re: custom type `color' is not enforced

[Lennart Borgman (gmail)]

Per Abrahamsen wrote:
>>From my unreliable memory:
> 
> The :validate function exist to check that the value the user has
> entered in the widget actually match the "type" of the widget.  If the
..
> The :match function exist to choose when "branch" to take for a choice
> widget, and a few similar situations:  E.g. if you instantiate a
...

Thanks Per, maybe I understand a little bit now. Are you saying that 
simple types should not have a match function?

> On 12/22/07, Lennart Borgman (gmail) <lennart.borgman@gmail.com> wrote:
>> Richard Stallman wrote:
>>> You have the right idea.
>> I have tried to finish the code too now ;-)

And I failed again ;-)

>> (defun custom-type-symbol-p (symbol custom-type)

Drew kindly told me this only works for simple types. I have to rethink 
this.

Re: custom type `color' is not enforced

[Per Abrahamsen]

On 12/23/07, Lennart Borgman (gmail) <lennart.borgman@gmail.com> wrote:
> Thanks Per, maybe I understand a little bit now. Are you saying that
> simple types should not have a match function?

The :match function for the choice type tries the :match function for
each option in turn, so atomic types definitely should have a :match
function.  It is what the composite types rely on.