Mercurial > emacs

changeset 27655:f894902025ff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(widgets) [defgroup]: Remove url link. (widget-color-choice-list, widget-color-history, widget-mouse-help): Deleted. (widget-specify-field, widget-specify-button): Don't use widget-mouse-help as help-echo property. (default): Use #'ignore for :validate and :mouse-down-action. (checkbox): Add help-echo. (widget-sexp-validate): Rewritten to clarify error messages. (character): Use char-valid-p in :match function. (widget-color-complete): Use facemenu-color-alist. (widget-color-action): Use facemenu-read-color.
author Dave Love <fx@gnu.org>
date Thu, 10 Feb 2000 17:47:48 +0000
parents cabb1b4c4424
children 7f30c54aeb09
files lisp/wid-edit.el
diffstat 1 files changed, 30 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/wid-edit.el	Wed Feb 09 23:54:58 2000 +0000
+++ b/lisp/wid-edit.el	Thu Feb 10 17:47:48 2000 +0000
@@ -1,12 +1,10 @@
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;
-;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF
 ;; Keywords: extensions
-;; Version: 1.9951
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (probably obsolete)
 
 ;; This file is part of GNU Emacs.
 
@@ -61,8 +59,6 @@
 (defgroup widgets nil
   "Customization support for the Widget Library."
   :link '(custom-manual "(widget)Top")
-  :link '(url-link :tag "Development Page" 
-		   "http://www.dina.kvl.dk/~abraham/custom/")
   :link '(emacs-library-link :tag "Lisp File" "widget.el")
   :prefix "widget-"
   :group 'extensions
@@ -325,9 +321,7 @@
 	(help-echo (widget-get widget :help-echo))
 	(overlay (make-overlay from to nil 
 			       nil (or (not widget-field-add-space)
-				       (widget-get widget :size)))))
-    (unless (or (stringp help-echo) (null help-echo))
-      (setq help-echo 'widget-mouse-help))    
+				       (widget-get widget :size)))))    
     (widget-put widget :field-overlay overlay)
     ;;(overlay-put overlay 'detachable nil)
     (overlay-put overlay 'field widget)
@@ -335,7 +329,8 @@
     ;;(overlay-put overlay 'keymap map)
     (overlay-put overlay 'face face)
     ;;(overlay-put overlay 'balloon-help help-echo)
-    (overlay-put overlay 'help-echo help-echo))
+    (if (stringp help-echo)
+	(overlay-put overlay 'help-echo help-echo)))
   (widget-specify-secret widget))
 
 (defun widget-specify-secret (field)
@@ -362,26 +357,13 @@
 	(help-echo (widget-get widget :help-echo))
 	(overlay (make-overlay from to nil t nil)))
     (widget-put widget :button-overlay overlay)
-    (unless (or (null help-echo) (stringp help-echo))
-      (setq help-echo 'widget-mouse-help))
     (overlay-put overlay 'button widget)
     (overlay-put overlay 'mouse-face widget-mouse-face)
     ;;(overlay-put overlay 'balloon-help help-echo)
-    (overlay-put overlay 'help-echo help-echo)
+    (if (stringp help-echo)
+	(overlay-put overlay 'help-echo help-echo))
     (overlay-put overlay 'face face)))
 
-(defun widget-mouse-help (extent)
-  "Find mouse help string for button in extent."
-  (let* ((widget (widget-at (extent-start-position extent)))
-	 (help-echo (and widget (widget-get widget :help-echo))))
-    (cond ((stringp help-echo)
-	   help-echo)
-	  ((and (symbolp help-echo) (fboundp help-echo)
-		(stringp (setq help-echo (funcall help-echo widget))))
-	   help-echo)
-	  (t
-	   (format "(widget %S :help-echo %S)" widget help-echo)))))
-
 (defun widget-specify-sample (widget from to)
   ;; Specify sample for WIDGET between FROM and TO.
   (let ((face (widget-apply widget :sample-face-get))
@@ -1350,11 +1332,11 @@
   :value-inline 'widget-default-value-inline
   :default-get 'widget-default-default-get
   :menu-tag-get 'widget-default-menu-tag-get
-  :validate (lambda (widget) nil)
+  :validate #'ignore
   :active 'widget-default-active
   :activate 'widget-specify-active
   :deactivate 'widget-default-deactivate
-  :mouse-down-action (lambda (widget event) nil)
+  :mouse-down-action #'ignore
   :action 'widget-default-action
   :notify 'widget-default-notify
   :prompt-value 'widget-default-prompt-value)
@@ -2121,6 +2103,7 @@
   :on-glyph "check1"
   :off "[ ]"
   :off-glyph "check0"
+  :help-echo "Toggle this item."
   :action 'widget-checkbox-action)
 
 (defun widget-checkbox-action (widget &optional event)
@@ -3148,13 +3131,16 @@
 
 (defun widget-sexp-validate (widget)
   ;; Valid if we can read the string and there is no junk left after it.
-  (save-excursion
-    (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*"))))
-      (erase-buffer)
-      (insert (widget-apply widget :value-get))
-      (goto-char (point-min))
-      (condition-case data
-	  (let ((value (read buffer)))
+  (with-temp-buffer
+    (insert (widget-apply widget :value-get))
+    (goto-char (point-min))
+    (condition-case data
+	(progn
+	  ;; Avoid a confusing end-of-file error.
+	  (skip-syntax-forward "\\s-")
+	  (if (eobp)
+	      (error "Empty sexp -- use `nil'?"))
+	  (let ((value (read (current-buffer))))
 	    (if (eobp)
 		(if (widget-apply widget :match value)
 		    nil
@@ -3164,9 +3150,12 @@
 			  :error (format "Junk at end of expression: %s"
 					 (buffer-substring (point)
 							   (point-max))))
-	      widget))
-	(error (widget-put widget :error (error-message-string data))
-	       widget)))))
+	      widget)))
+      (end-of-file			; Avoid confusing error message.
+       (widget-put widget :error "Unbalanced sexp")
+       widget)
+      (error (widget-put widget :error (error-message-string data))
+	     widget))))
 
 (defvar widget-sexp-prompt-value-history nil
   "History of input to `widget-sexp-prompt-value'.")
@@ -3241,9 +3230,7 @@
 			   (aref value 0)
 			 value))
   :match (lambda (widget value)
-	   (if (fboundp 'characterp)
-	       (characterp value)
-	     (integerp value))))
+	   (char-valid-p value)))
 
 (define-widget 'list 'group
   "A Lisp list."
@@ -3464,9 +3451,11 @@
 
 (defun widget-color-complete (widget)
   "Complete the color in WIDGET."
+  (require 'facemenu)			; for facemenu-color-alist
   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
 						 (point)))
-	 (list (widget-color-choice-list))
+	 (list (or facemenu-color-alist
+		   (mapcar 'list (defined-colors))))
 	 (completion (try-completion prefix list)))
     (cond ((eq completion t)
 	   (message "Exact match."))
@@ -3490,19 +3479,6 @@
 	(facemenu-get-face symbol)
       (error 'default))))
 
-(defvar widget-color-choice-list nil)
-;; Variable holding the possible colors.
-
-(defun widget-color-choice-list ()
-  (unless widget-color-choice-list
-    (setq widget-color-choice-list 
-	  (mapcar '(lambda (color) (list color))
-		  (x-defined-colors))))
-  widget-color-choice-list)
-
-(defvar widget-color-history nil
-  "History of entered colors")
-
 (defun widget-color-action (widget &optional event)
   ;; Prompt for a color.
   (let* ((tag (widget-apply widget :menu-tag-get))
@@ -3515,13 +3491,7 @@
 		     (length value))
 		    (t
 		     (- (point) start))))
-	 (answer (if (commandp 'read-color)
-		     (read-color prompt)
-		   (completing-read (concat tag ": ")
-				    (widget-color-choice-list) 
-				    nil nil 
-				    (cons value pos)
-				    'widget-color-history))))
+	 (answer (facemenu-read-color prompt)))
     (unless (zerop (length answer))
       (widget-value-set widget answer)
       (widget-setup)