X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/783824f57e2cce55d82c0228b85570ad004a7baa..41674a5aa2626979d2ddf1b40ef42ceabdef540b:/lisp/wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 5cb487be06..c8d46533d4 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,11 +1,12 @@
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;
-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999 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/
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (probably obsolete)
 
 ;; This file is part of GNU Emacs.
 
@@ -46,18 +47,6 @@
   (autoload 'Info-goto-node "info")
   (autoload 'finder-commentary "finder" nil t)
 
-  (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
-    ;; We have the old custom-library, hack around it!
-    (defmacro defgroup (&rest args) nil)
-    (defmacro defcustom (var value doc &rest args) 
-      (` (defvar (, var) (, value) (, doc))))
-    (defmacro defface (&rest args) nil)
-    (define-widget-keywords :prefix :tag :load :link :options :type :group)
-    (when (fboundp 'copy-face)
-      (copy-face 'default 'widget-documentation-face)
-      (copy-face 'bold 'widget-button-face)
-      (copy-face 'italic 'widget-field-face)))
-
   (unless (fboundp 'button-release-event-p)
     ;; XEmacs function missing from Emacs.
     (defun button-release-event-p (event)
@@ -89,7 +78,7 @@
   :group 'faces)
 
 (defvar widget-documentation-face 'widget-documentation-face
-  "Face used for documentation strings in widges.
+  "Face used for documentation strings in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 
 (defface widget-documentation-face '((((class color)
@@ -104,7 +93,7 @@ This exists as a variable so it can be set locally in certain buffers.")
   :group 'widget-faces)
 
 (defvar widget-button-face 'widget-button-face
-  "Face used for buttons in widges.
+  "Face used for buttons in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 
 (defface widget-button-face '((t (:bold t)))
@@ -176,7 +165,13 @@ Larger menus are read through the minibuffer."
   :group 'widgets
   :type 'integer)
 
-(defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version)
+(defcustom widget-menu-max-shortcuts 40
+  "Largest number of items for which it works to choose one with a character.
+For a larger number of items, the minibuffer is used."
+  :group 'widgets
+  :type 'integer)
+
+(defcustom widget-menu-minibuffer-flag nil
   "*Control how to ask for a choice from the keyboard.
 Non-nil means use the minibuffer;
 nil means read a single character."
@@ -202,7 +197,8 @@ minibuffer."
 	 ;; We are in Emacs-19, pressed by the mouse
 	 (x-popup-menu event
 		       (list title (cons "" items))))
-	(widget-menu-minibuffer-flag
+	((or widget-menu-minibuffer-flag
+	     (> (length items) widget-menu-max-shortcuts))
 	 ;; Read the choice of name from the minibuffer.
 	 (setq items (widget-remove-if 'stringp items))
 	 (let ((val (completing-read (concat title ": ") items nil t)))
@@ -333,13 +329,32 @@ new value."
     (unless (or (stringp help-echo) (null help-echo))
       (setq help-echo 'widget-mouse-help))    
     (widget-put widget :field-overlay overlay)
-    (overlay-put overlay 'detachable nil)
+    ;;(overlay-put overlay 'detachable nil)
     (overlay-put overlay 'field widget)
     (overlay-put overlay 'local-map map)
-    (overlay-put overlay 'keymap map)
+    ;;(overlay-put overlay 'keymap map)
     (overlay-put overlay 'face face)
-    (overlay-put overlay 'balloon-help help-echo)
-    (overlay-put overlay 'help-echo help-echo)))
+    ;;(overlay-put overlay 'balloon-help help-echo)
+    (overlay-put overlay 'help-echo help-echo))
+  (widget-specify-secret widget))
+
+(defun widget-specify-secret (field)
+  "Replace text in FIELD with value of `:secret', if non-nil."
+  (let ((secret (widget-get field :secret))
+	(size (widget-get field :size)))
+    (when secret
+      (let ((begin (widget-field-start field))
+	    (end (widget-field-end field)))
+	(when size 
+	  (while (and (> end begin)
+		      (eq (char-after (1- end)) ?\ ))
+	    (setq end (1- end))))
+	(while (< begin end)
+	  (let ((old (char-after begin)))
+	    (unless (eq old secret)
+	      (subst-char-in-region begin (1+ begin) old secret)
+	      (put-text-property begin (1+ begin) 'secret old))
+	    (setq begin (1+ begin))))))))
 
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."
@@ -351,7 +366,7 @@ new value."
       (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 'balloon-help help-echo)
     (overlay-put overlay 'help-echo help-echo)
     (overlay-put overlay 'face face)))
 
@@ -418,15 +433,13 @@ new value."
       ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
       (overlay-put overlay 'evaporate t)
       (overlay-put overlay 'priority 100)
-      (overlay-put overlay (if (string-match "XEmacs" emacs-version)
-			       'read-only
-			     'modification-hooks) '(widget-overlay-inactive))
+      (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))
       (widget-put widget :inactive overlay))))
 
 (defun widget-overlay-inactive (&rest junk)
   "Ignoring the arguments, signal an error."
   (unless inhibit-read-only
-    (error "Attempt to modify inactive widget")))
+    (error "The widget here is not active")))
 
 
 (defun widget-specify-active (widget)
@@ -471,12 +484,12 @@ Otherwise, just return the value."
 					 :value-to-internal value)))
 
 (defun widget-default-get (widget)
-  "Extract the defaylt value of WIDGET."
+  "Extract the default value of WIDGET."
   (or (widget-get widget :value)
       (widget-apply widget :default-get)))
 
 (defun widget-match-inline (widget vals)
-  ;; In WIDGET, match the start of VALS.
+  "In WIDGET, match the start of VALS."
   (cond ((widget-get widget :inline)
 	 (widget-apply widget :match-inline vals))
 	((and vals
@@ -860,8 +873,7 @@ Recommended as a parent keymap for modes using widgets.")
 
 (unless widget-field-keymap 
   (setq widget-field-keymap (copy-keymap widget-keymap))
-  (unless (string-match "XEmacs" (emacs-version))
-    (define-key widget-field-keymap [menu-bar] 'nil))
+  (define-key widget-field-keymap [menu-bar] 'nil)
   (define-key widget-field-keymap "\C-k" 'widget-kill-line)
   (define-key widget-field-keymap "\M-\t" 'widget-complete)
   (define-key widget-field-keymap "\C-m" 'widget-field-activate)
@@ -874,8 +886,7 @@ Recommended as a parent keymap for modes using widgets.")
 
 (unless widget-text-keymap 
   (setq widget-text-keymap (copy-keymap widget-keymap))
-  (unless (string-match "XEmacs" (emacs-version))
-    (define-key widget-text-keymap [menu-bar] 'nil))
+  (define-key widget-text-keymap [menu-bar] 'nil)
   (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line)
   (define-key widget-text-keymap "\C-e" 'widget-end-of-line)
   (set-keymap-parent widget-text-keymap global-map))
@@ -889,6 +900,10 @@ Recommended as a parent keymap for modes using widgets.")
       (call-interactively
        (lookup-key widget-global-map (this-command-keys))))))
 
+(defvar widget-button-pressed-face 'widget-button-pressed-face
+  "Face used for pressed buttons in widgets.
+This exists as a variable so it can be set locally in certain buffers.")
+
 (defface widget-button-pressed-face 
   '((((class color))
      (:foreground "red"))
@@ -913,29 +928,30 @@ Recommended as a parent keymap for modes using widgets.")
 		      (mouse-face (overlay-get overlay 'mouse-face)))
 		 (unwind-protect
 		     (let ((track-mouse t))
-		       (overlay-put overlay
-				    'face 'widget-button-pressed-face)
-		       (overlay-put overlay 
-				    'mouse-face 'widget-button-pressed-face)
-		       (unless (widget-apply button :mouse-down-action event)
-			 (while (not (button-release-event-p event))
-			   (setq event (widget-read-event)
-				 pos (widget-event-point event))
-			   (if (and pos
-				    (eq (get-char-property pos 'button)
-					button))
-			       (progn 
-				 (overlay-put overlay 
-					      'face
-					      'widget-button-pressed-face)
-				 (overlay-put overlay 
-					      'mouse-face 
-					      'widget-button-pressed-face))
-			     (overlay-put overlay 'face face)
-			     (overlay-put overlay 'mouse-face mouse-face))))
-		       (when (and pos 
-				  (eq (get-char-property pos 'button) button))
-			 (widget-apply-action button event)))
+		       (save-excursion
+			 (overlay-put overlay
+				      'face widget-button-pressed-face)
+			 (overlay-put overlay 
+				      'mouse-face widget-button-pressed-face)
+			 (unless (widget-apply button :mouse-down-action event)
+			   (while (not (button-release-event-p event))
+			     (setq event (widget-read-event)
+				   pos (widget-event-point event))
+			     (if (and pos
+				      (eq (get-char-property pos 'button)
+					  button))
+				 (progn 
+				   (overlay-put overlay 
+						'face
+						widget-button-pressed-face)
+				   (overlay-put overlay 
+						'mouse-face 
+						widget-button-pressed-face))
+			       (overlay-put overlay 'face face)
+			       (overlay-put overlay 'mouse-face mouse-face))))
+			 (when (and pos 
+				    (eq (get-char-property pos 'button) button))
+			   (widget-apply-action button event))))
 		   (overlay-put overlay 'face face)
 		   (overlay-put overlay 'mouse-face mouse-face)))
 	     (let ((up t)
@@ -1022,11 +1038,9 @@ POS defaults to the value of (point)."
 	    widget))
       nil)))
 
-(defcustom widget-use-overlay-change (string-match "XEmacs" emacs-version)
+(defvar widget-use-overlay-change t
   "If non-nil, use overlay change functions to tab around in the buffer.
-This is much faster, but doesn't work reliably on Emacs 19.34."
-  :type 'boolean
-  :group 'widgets)
+This is much faster, but doesn't work reliably on Emacs 19.34.")
 
 (defun widget-move (arg)
   "Move point to the ARG next field or button.
@@ -1092,19 +1106,25 @@ With optional ARG, move across that many fields."
   "Go to beginning of field or beginning of line, whichever is first."
   (interactive)
   (let* ((field (widget-field-find (point)))
-	 (start (and field (widget-field-start field))))
-    (if (and start (not (eq start (point))))
-	(goto-char start)
-      (call-interactively 'beginning-of-line))))
+	 (start (and field (widget-field-start field)))
+         (bol (save-excursion
+                (beginning-of-line)
+                (point))))
+    (goto-char (if start
+                   (max start bol)
+                 bol))))
 
 (defun widget-end-of-line ()
   "Go to end of field or end of line, whichever is first."
   (interactive)
   (let* ((field (widget-field-find (point)))
-	 (end (and field (widget-field-end field))))
-    (if (and end (not (eq end (point))))
-	(goto-char end)
-      (call-interactively 'end-of-line))))
+	 (end (and field (widget-field-end field)))
+         (eol (save-excursion
+                (end-of-line)
+                (point))))
+    (goto-char (if end
+                   (min end eol)
+                 eol))))
 
 (defun widget-kill-line ()
   "Kill to end of field or end of line, whichever is first."
@@ -1211,10 +1231,12 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
 	  (to-field (widget-field-find to)))
       (cond ((not (eq from-field to-field))
 	     (add-hook 'post-command-hook 'widget-add-change nil t)
-	     (error "Change should be restricted to a single field"))
+	     (signal 'text-read-only
+		     '("Change should be restricted to a single field")))
 	    ((null from-field)
 	     (add-hook 'post-command-hook 'widget-add-change nil t)
-	     (error "Attempt to change text outside editable field"))
+	     (signal 'text-read-only
+		     '("Attempt to change text outside editable field")))
 	    (widget-field-use-before-change
 	     (condition-case nil
 		 (widget-apply from-field :notify from-field)
@@ -1236,8 +1258,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
 	(when field
 	  (unless (eq field other)
 	    (debug "Change in different fields"))
-	  (let ((size (widget-get field :size))
-		(secret (widget-get field :secret)))
+	  (let ((size (widget-get field :size)))
 	    (when size 
 	      (let ((begin (widget-field-start field))
 		    (end (widget-field-end field)))
@@ -1259,19 +1280,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
 			 (while (and (eq (preceding-char) ?\ )
 				     (> (point) begin))
 			   (delete-backward-char 1)))))))
-	    (when secret
-	      (let ((begin (widget-field-start field))
-		    (end (widget-field-end field)))
-		(when size 
-		  (while (and (> end begin)
-			      (eq (char-after (1- end)) ?\ ))
-		    (setq end (1- end))))
-		(while (< begin end)
-		  (let ((old (char-after begin)))
-		    (unless (eq old secret)
-		      (subst-char-in-region begin (1+ begin) old secret)
-		      (put-text-property begin (1+ begin) 'secret old))
-		    (setq begin (1+ begin)))))))
+	    (widget-specify-secret field))
 	  (widget-apply field :notify field)))
     (error (debug "After Change"))))
 
@@ -1928,7 +1937,7 @@ If END is omitted, it defaults to the length of LIST."
 	(explicit (widget-get widget :explicit-choice))
 	(explicit-value (widget-get widget :explicit-choice-value))
 	current)
-    (if (and explicit (eq value explicit-value))
+    (if (and explicit (equal value explicit-value))
 	(progn
 	  ;; If the user specified the choice for this value,
 	  ;; respect that choice as long as the value is the same.
@@ -2651,7 +2660,9 @@ when he invoked the menu."
 		    (setq child (widget-create-child-value 
 				 widget type value))
 		  (setq child (widget-create-child-value 
-			       widget type (widget-default-get type)))))
+			       widget type
+			       (widget-apply type :value-to-external
+					     (widget-default-get type))))))
 	       (t 
 		(error "Unknown escape `%c'" escape)))))
      (widget-put widget 
@@ -2671,7 +2682,7 @@ when he invoked the menu."
 ;;; The `group' Widget.
 
 (define-widget 'group 'default
-  "A widget which group other widgets inside."
+  "A widget which groups other widgets inside."
   :convert-widget 'widget-types-convert-widget
   :format "%v"
   :value-create 'widget-group-value-create
@@ -2818,7 +2829,10 @@ link for that string."
     (let ((regexp widget-documentation-link-regexp)
 	  (predicate widget-documentation-link-p)
 	  (type widget-documentation-link-type)
-	  (buttons (widget-get widget :buttons)))
+	  (buttons (widget-get widget :buttons))
+	  (widget-mouse-face (default-value 'widget-mouse-face))
+	  (widget-button-face widget-documentation-face)
+	  (widget-button-pressed-face widget-documentation-face))
       (save-excursion
 	(goto-char from)
 	(while (re-search-forward regexp to t)
@@ -2884,7 +2898,7 @@ link for that string."
 		(not (widget-get parent :documentation-shown))))
   ;; Redraw.
   (widget-value-set widget (widget-value widget)))
-
+
 ;;; The Sexp Widgets.
 
 (define-widget 'const 'item
@@ -2909,6 +2923,17 @@ link for that string."
   :format "%v\n%h"
   :documentation-property 'variable-documentation)
 
+(define-widget 'other 'sexp
+  "Matches any value, but doesn't let the user edit the value.
+This is useful as last item in a `choice' widget.
+You should use this widget type with a default value,
+as in (other DEFAULT) or (other :tag \"NAME\" DEFAULT).
+If the user selects this alternative, that specifies DEFAULT
+as the value."
+  :tag "Other"
+  :format "%t%n"
+  :value 'other)
+
 (defvar widget-string-prompt-value-history nil
   "History of input to `widget-string-prompt-value'.")
 
@@ -3059,48 +3084,46 @@ It will read a directory name from the minibuffer when invoked."
 
 (define-widget 'variable 'symbol
   ;; Should complete on variables.
-  "A lisp variable."
+  "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
   :tag "Variable")
 
-(when (featurep 'mule)
-  (defvar widget-coding-system-prompt-value-history nil
-    "History of input to `widget-coding-system-prompt-value'.")
+(defvar widget-coding-system-prompt-value-history nil
+  "History of input to `widget-coding-system-prompt-value'.")
   
-  (define-widget 'coding-system 'symbol
-    "A MULE coding-system."
-    :format "%{%t%}: %v"
-    :tag "Coding system"
-    :prompt-history 'widget-coding-system-prompt-value-history
-    :prompt-value 'widget-coding-system-prompt-value
-    :action 'widget-coding-system-action)
+(define-widget 'coding-system 'symbol
+  "A MULE coding-system."
+  :format "%{%t%}: %v"
+  :tag "Coding system"
+  :prompt-history 'widget-coding-system-prompt-value-history
+  :prompt-value 'widget-coding-system-prompt-value
+  :action 'widget-coding-system-action)
   
-  (defun widget-coding-system-prompt-value (widget prompt value unbound)
-    ;; Read coding-system from minibuffer.
-    (intern
-     (completing-read (format "%s (default %s) " prompt value)
-		      (mapcar (function
-			       (lambda (sym)
-				 (list (symbol-name sym))
-				 ))
-			      (coding-system-list)))))
-
-  (defun widget-coding-system-action (widget &optional event)
-    ;; Read a file name from the minibuffer.
-    (let ((answer
-	   (widget-coding-system-prompt-value
-	    widget
-	    (widget-apply widget :menu-tag-get)
-	    (widget-value widget)
-	    t)))
-      (widget-value-set widget answer)
-      (widget-apply widget :notify widget event)
-      (widget-setup)))
-  )
-
+(defun widget-coding-system-prompt-value (widget prompt value unbound)
+  ;; Read coding-system from minibuffer.
+  (intern
+   (completing-read (format "%s (default %s) " prompt value)
+		    (mapcar (function
+			     (lambda (sym)
+			       (list (symbol-name sym))
+			       ))
+			    (coding-system-list)))))
+
+(defun widget-coding-system-action (widget &optional event)
+  ;; Read a file name from the minibuffer.
+  (let ((answer
+	 (widget-coding-system-prompt-value
+	  widget
+	  (widget-apply widget :menu-tag-get)
+	  (widget-value widget)
+	  t)))
+    (widget-value-set widget answer)
+    (widget-apply widget :notify widget event)
+    (widget-setup)))
+
 (define-widget 'sexp 'editable-field
-  "An arbitrary lisp expression."
+  "An arbitrary Lisp expression."
   :tag "Lisp expression"
   :format "%{%t%}: %v"
   :value nil
@@ -3186,7 +3209,7 @@ To use this type, you must define :match or :match-alternatives."
 	  (setq matched t))
       (setq alternatives (cdr alternatives)))
     matched))
-
+
 (define-widget 'integer 'restricted-sexp
   "An integer."
   :tag "Integer"
@@ -3223,12 +3246,12 @@ To use this type, you must define :match or :match-alternatives."
 	     (integerp value))))
 
 (define-widget 'list 'group
-  "A lisp list."
+  "A Lisp list."
   :tag "List"
   :format "%{%t%}:\n%v")
 
 (define-widget 'vector 'group
-  "A lisp vector."
+  "A Lisp vector."
   :tag "Vector"
   :format "%{%t%}:\n%v"
   :match 'widget-vector-match
@@ -3254,7 +3277,98 @@ To use this type, you must define :match or :match-alternatives."
   (and (consp value)
        (widget-group-match widget
 			   (widget-apply widget :value-to-internal value))))
+
+;;; The `plist' Widget.
+;;
+;; Property lists.
+
+(define-widget 'plist 'list
+  "A property list."
+  :key-type '(symbol :tag "Key")
+  :value-type '(sexp :tag "Value")
+  :convert-widget 'widget-plist-convert-widget
+  :tag "Plist")
+
+(defvar widget-plist-value-type)	;Dynamic variable
+
+(defun widget-plist-convert-widget (widget)
+  ;; Handle `:options'.
+  (let* ((options (widget-get widget :options))
+	 (key-type (widget-get widget :key-type))
+	 (widget-plist-value-type (widget-get widget :value-type))
+	 (other `(editable-list :inline t 
+				(group :inline t
+				       ,key-type
+				       ,widget-plist-value-type)))
+	 (args (if options
+		   (list `(checklist :inline t
+				     :greedy t
+				     ,@(mapcar 'widget-plist-convert-option
+					       options))
+			 other)
+		 (list other))))
+    (widget-put widget :args args)
+    widget))
 
+(defun widget-plist-convert-option (option)
+  ;; Convert a single plist option.
+  (let (key-type value-type)
+    (if (listp option)
+	(let ((key (nth 0 option)))
+	  (setq value-type (nth 1 option))
+	  (if (listp key)
+	      (setq key-type key)
+	    (setq key-type `(const ,key))))
+      (setq key-type `(const ,option)
+	    value-type widget-plist-value-type))
+    `(group :format "Key: %v" :inline t ,key-type ,value-type)))
+
+
+;;; The `alist' Widget.
+;;
+;; Association lists.
+
+(define-widget 'alist 'list
+  "An association list."
+  :key-type '(sexp :tag "Key")
+  :value-type '(sexp :tag "Value")
+  :convert-widget 'widget-alist-convert-widget
+  :tag "Alist")
+
+(defvar widget-alist-value-type)	;Dynamic variable
+
+(defun widget-alist-convert-widget (widget)
+  ;; Handle `:options'.
+  (let* ((options (widget-get widget :options))
+	 (key-type (widget-get widget :key-type))
+	 (widget-alist-value-type (widget-get widget :value-type))
+	 (other `(editable-list :inline t 
+				(cons :format "%v"
+				      ,key-type
+				      ,widget-alist-value-type)))
+	 (args (if options
+		   (list `(checklist :inline t
+				     :greedy t
+				     ,@(mapcar 'widget-alist-convert-option
+					       options))
+			 other)
+		 (list other))))
+    (widget-put widget :args args)
+    widget))
+
+(defun widget-alist-convert-option (option)
+  ;; Convert a single alist option.
+  (let (key-type value-type)
+    (if (listp option)
+	(let ((key (nth 0 option)))
+	  (setq value-type (nth 1 option))
+	  (if (listp key)
+	      (setq key-type key)
+	    (setq key-type `(const ,key))))
+      (setq key-type `(const ,option)
+	    value-type widget-alist-value-type))
+    `(cons :format "Key: %v" ,key-type ,value-type)))
+
 (define-widget 'choice 'menu-choice
   "A union of several sexp types."
   :tag "Choice"
@@ -3304,7 +3418,7 @@ To use this type, you must define :match or :match-alternatives."
     (if current
 	(widget-prompt-value current prompt nil t)
       value)))
-
+
 (define-widget 'radio 'radio-button-choice
   "A union of several sexp types."
   :tag "Choice"
@@ -3334,7 +3448,7 @@ To use this type, you must define :match or :match-alternatives."
 (defun widget-boolean-prompt-value (widget prompt value unbound)
   ;; Toggle a boolean.
   (y-or-n-p prompt))
-
+
 ;;; The `color' Widget.
 
 (define-widget 'color 'editable-field 
@@ -3418,41 +3532,9 @@ To use this type, you must define :match or :match-alternatives."
   (overlay-put (widget-get widget :sample-overlay) 
 	       'face (widget-apply widget :sample-face-get))
   (widget-default-notify widget child event))
-
+
 ;;; The Help Echo
 
-(defun widget-echo-help-mouse ()
-  "Display the help message for the widget under the mouse.
-Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)"
-  (let* ((pos (mouse-position))
-	 (frame (car pos))
-	 (x (car (cdr pos)))
-	 (y (cdr (cdr pos)))
-	 (win (window-at x y frame))
-	 (where (coordinates-in-window-p (cons x y) win)))
-    (when (consp where)
-      (save-window-excursion
-	(progn ; save-excursion
-	  (select-window win)
-	  (let* ((result (compute-motion (window-start win)
-					 '(0 . 0)
-					 (point-max)
-					 where
-					 (window-width win)
-					 (cons (window-hscroll) 0)
-					 win)))
-	    (when (and (eq (nth 1 result) x)
-		       (eq (nth 2 result) y))
-	      (widget-echo-help (nth 0 result))))))))
-  (unless track-mouse
-    (setq track-mouse t)
-    (add-hook 'post-command-hook 'widget-stop-mouse-tracking)))
-
-(defun widget-stop-mouse-tracking (&rest args)
-  "Stop the mouse tracking done while idle."
-  (remove-hook 'post-command-hook 'widget-stop-mouse-tracking)
-  (setq track-mouse nil))
-
 (defun widget-at (pos)
   "The button or field at POS."
   (or (get-char-property pos 'button)