Mercurial > emacs

changeset 25686:c1a7a52bbfea

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove some compatibility code and checks. (widget-specify-field, widget-specify-button): Don't use XEmacs properties. (widget-overlay-inactive): Change error message. (widget-button-pressed-face): New variable. (widget-button-click): Use it. (widget-documentation-link-add): Specify mouse and button faces. (widget-echo-help-mouse, widget-stop-mouse-tracking): Functions removed now the functionality is built in.
author Dave Love <fx@gnu.org>
date Mon, 13 Sep 1999 13:54:33 +0000
parents fc2bfab28ed7
children afad62240679
files lisp/wid-edit.el
diffstat 1 files changed, 27 insertions(+), 67 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/wid-edit.el	Mon Sep 13 13:44:41 1999 +0000
+++ b/lisp/wid-edit.el	Mon Sep 13 13:54:33 1999 +0000
@@ -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 @@
   :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)))
@@ -340,12 +329,12 @@
     (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 'balloon-help help-echo)
     (overlay-put overlay 'help-echo help-echo))
   (widget-specify-secret widget))
 
@@ -377,7 +366,7 @@
       (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)))
 
@@ -444,15 +433,13 @@
       ;; (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)
@@ -502,7 +489,7 @@
       (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
@@ -886,8 +873,7 @@
 
 (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)
@@ -900,8 +886,7 @@
 
 (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))
@@ -915,6 +900,10 @@
       (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"))
@@ -940,9 +929,9 @@
 		 (unwind-protect
 		     (let ((track-mouse t))
 		       (overlay-put overlay
-				    'face 'widget-button-pressed-face)
+				    'face widget-button-pressed-face)
 		       (overlay-put overlay 
-				    'mouse-face 'widget-button-pressed-face)
+				    '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)
@@ -953,10 +942,10 @@
 			       (progn 
 				 (overlay-put overlay 
 					      'face
-					      'widget-button-pressed-face)
+					      widget-button-pressed-face)
 				 (overlay-put overlay 
 					      'mouse-face 
-					      'widget-button-pressed-face))
+					      widget-button-pressed-face))
 			     (overlay-put overlay 'face face)
 			     (overlay-put overlay 'mouse-face mouse-face))))
 		       (when (and pos 
@@ -2692,7 +2681,7 @@
 ;;; 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
@@ -2839,7 +2828,10 @@
     (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)
@@ -3542,38 +3534,6 @@
 
 ;;; 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)