From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: "Per Abrahamsen" Newsgroups: gmane.emacs.devel Subject: Re: custom type `color' is not enforced Date: Sun, 23 Dec 2007 11:54:57 +0100 Message-ID: <66a8b7a0712230254y72c8b988j3f4f7e69a8bacbc4@mail.gmail.com> References: <476B8932.7030500@gmail.com> <476D7A66.2080901@gmail.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit X-Trace: ger.gmane.org 1198407314 31322 80.91.229.12 (23 Dec 2007 10:55:14 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 23 Dec 2007 10:55:14 +0000 (UTC) Cc: rms@gnu.org, drew.adams@oracle.com, emacs-devel@gnu.org To: "Lennart Borgman (gmail)" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Dec 23 11:55:27 2007 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1J6OUP-000440-JY for ged-emacs-devel@m.gmane.org; Sun, 23 Dec 2007 11:55:26 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1J6OU5-00070g-IK for ged-emacs-devel@m.gmane.org; Sun, 23 Dec 2007 05:55:05 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1J6OU1-0006yi-6A for emacs-devel@gnu.org; Sun, 23 Dec 2007 05:55:01 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1J6OTz-0006xL-Uh for emacs-devel@gnu.org; Sun, 23 Dec 2007 05:55:00 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1J6OTz-0006x2-Mn for emacs-devel@gnu.org; Sun, 23 Dec 2007 05:54:59 -0500 Original-Received: from wa-out-1112.google.com ([209.85.146.176]) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1J6OTz-0007sR-40 for emacs-devel@gnu.org; Sun, 23 Dec 2007 05:54:59 -0500 Original-Received: by wa-out-1112.google.com with SMTP id k34so1849851wah.10 for ; Sun, 23 Dec 2007 02:54:57 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:received:received:message-id:date:from:to:subject:cc:in-reply-to:mime-version:content-type:content-transfer-encoding:content-disposition:references; bh=q2BqMS+iaPcKoQxpaW/8Vz3Kemkz575viXk3SCueDMU=; b=mF8WtERk6q+yAnLBTV/hzC6BrPoA+Ed4TAlg0bTXEpr+G++73VYyfV+IAb0zifdqkKcNwP5jQR/F22njLvyCoiFP+Gs6gIlnWti+HPEGFSGlHg5y55+uOt5bSYSxUZMIST2UbGFdlrdVGBrv+nVHIZpbxwmy05tdiEU6Lpok+T8= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=message-id:date:from:to:subject:cc:in-reply-to:mime-version:content-type:content-transfer-encoding:content-disposition:references; b=pmfMkH4KFfHVTtbbSrXuC8jh7FrjxqJ5GKaZvDhR0PzuTorBO4YFgaz5W1YOANcVqfz9T5iXiC33TRKLuRucYUegVJmaOqaGlgvKhNmEOoy+wDYSwC3PI/6bU8mIeRpdXkaTyYznJpbxO2jEkrKas4Rl3hMfyCJFV4CbkX3uwQE= Original-Received: by 10.114.144.1 with SMTP id r1mr2559714wad.53.1198407297323; Sun, 23 Dec 2007 02:54:57 -0800 (PST) Original-Received: by 10.115.54.11 with HTTP; Sun, 23 Dec 2007 02:54:57 -0800 (PST) In-Reply-To: <476D7A66.2080901@gmail.com> Content-Disposition: inline X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 2) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:85403 Archived-At: >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) 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) > >