hide-ifdef-mode documented; mark some entries as not needed doc updates.

[bpt/emacs.git] / lisp / wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 5e5dbd4..c0135f8 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,7 +1,7 @@
 ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
 ;;
 ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
 ;;

-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007, 2008  Free Software Foundation, Inc.

 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF


@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Wishlist items (from widget.texi):
 
 
 ;;; Wishlist items (from widget.texi):
 


@@ -405,7 +403,17 @@ new value.")
     (unless (widget-get widget :suppress-face)
       (overlay-put overlay 'face (widget-apply widget :button-face-get))
       (overlay-put overlay 'mouse-face
     (unless (widget-get widget :suppress-face)
       (overlay-put overlay 'face (widget-apply widget :button-face-get))
       (overlay-put overlay 'mouse-face

-                  (widget-apply widget :mouse-face-get)))
+                  ;; Make new list structure for the mouse-face value
+                  ;; so that different widgets will have
+                  ;; different `mouse-face' property values
+                  ;; and will highlight separately.
+                  (let ((mouse-face-value
+                         (widget-apply widget :mouse-face-get)))
+                    ;; If it's a list, copy it.
+                    (if (listp mouse-face-value)
+                        (copy-sequence mouse-face-value)
+                      ;; If it's a symbol, put it in a list.
+                      (list mouse-face-value)))))

     (overlay-put overlay 'pointer 'hand)
     (overlay-put overlay 'follow-link follow-link)
     (overlay-put overlay 'help-echo help-echo)))
     (overlay-put overlay 'pointer 'hand)
     (overlay-put overlay 'follow-link follow-link)
     (overlay-put overlay 'help-echo help-echo)))


@@ -478,12 +486,12 @@ new value.")
 ;;; Widget Properties.
 
 (defsubst widget-type (widget)
 ;;; Widget Properties.
 
 (defsubst widget-type (widget)

-  "Return the type of WIDGET, a symbol."
+  "Return the type of WIDGET.  The type is a symbol."

   (car widget))
 
 ;;;###autoload
 (defun widgetp (widget)
   (car widget))
 
 ;;;###autoload
 (defun widgetp (widget)

-  "Return non-nil iff WIDGET is a widget."
+  "Return non-nil if WIDGET is a widget."

   (if (symbolp widget)
       (get widget 'widget-type)
     (and (consp widget)
   (if (symbolp widget)
       (get widget 'widget-type)
     (and (consp widget)


@@ -500,7 +508,7 @@ Otherwise, just return the value."
       value)))
 
 (defun widget-member (widget property)
       value)))
 
 (defun widget-member (widget property)

-  "Non-nil iff there is a definition in WIDGET for PROPERTY."
+  "Non-nil if there is a definition in WIDGET for PROPERTY."

   (cond ((plist-member (cdr widget) property)
         t)
        ((car widget)
   (cond ((plist-member (cdr widget) property)
         t)
        ((car widget)


@@ -591,7 +599,7 @@ respectively."
 ;;; Images.
 
 (defcustom widget-image-directory (file-name-as-directory
 ;;; Images.
 
 (defcustom widget-image-directory (file-name-as-directory

-                                  (expand-file-name "custom" data-directory))
+                                  (expand-file-name "images/custom" data-directory))

   "Where widget button images are located.
 If this variable is nil, widget will try to locate the directory
 automatically."
   "Where widget button images are located.
 If this variable is nil, widget will try to locate the directory
 automatically."


@@ -654,9 +662,7 @@ button is pressed or inactive, respectively.  These are currently ignored."
   (if (and (display-graphic-p)
           (setq image (widget-image-find image)))
       (progn (widget-put widget :suppress-face t)
   (if (and (display-graphic-p)
           (setq image (widget-image-find image)))
       (progn (widget-put widget :suppress-face t)

-            (insert-image image
-                          (propertize
-                           tag 'mouse-face widget-button-pressed-face)))
+            (insert-image image tag))

     (insert tag)))
 
 (defun widget-move-and-invoke (event)
     (insert tag)))
 
 (defun widget-move-and-invoke (event)


@@ -850,7 +856,9 @@ button end points."
 
 ;;; Keymap and Commands.
 
 
 ;;; Keymap and Commands.
 

-;;;###autoload
+;; This alias exists only so that one can choose in doc-strings (e.g.
+;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
+;; http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg00480.html

 (defalias 'advertised-widget-backward 'widget-backward)
 
 ;;;###autoload
 (defalias 'advertised-widget-backward 'widget-backward)
 
 ;;;###autoload


@@ -862,7 +870,9 @@ button end points."
     (define-key map [backtab] 'widget-backward)
     (define-key map [down-mouse-2] 'widget-button-click)
     (define-key map [down-mouse-1] 'widget-button-click)
     (define-key map [backtab] 'widget-backward)
     (define-key map [down-mouse-2] 'widget-button-click)
     (define-key map [down-mouse-1] 'widget-button-click)

-    (define-key map "\C-m" 'widget-button-press)
+    ;; The following definition needs to avoid using escape sequences that
+    ;; might get converted to ^M when building loaddefs.el
+    (define-key map [(control ?m)] 'widget-button-press)

     map)
   "Keymap containing useful binding for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")
     map)
   "Keymap containing useful binding for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")


@@ -1438,7 +1448,7 @@ The value of the :type attribute should be an unconverted widget type."
 
 (defun widget-default-complete (widget)
   "Call the value of the :complete-function property of WIDGET.
 
 (defun widget-default-complete (widget)
   "Call the value of the :complete-function property of WIDGET.

-If that does not exists, call the value of `widget-complete-field'."
+If that does not exist, call the value of `widget-complete-field'."

   (call-interactively (or (widget-get widget :complete-function)
                          widget-complete-field)))
 
   (call-interactively (or (widget-get widget :complete-function)
                          widget-complete-field)))
 


@@ -1606,7 +1616,7 @@ If that does not exists, call the value of `widget-complete-field'."
       (widget-princ-to-string (widget-get widget :value))))
 
 (defun widget-default-active (widget)
       (widget-princ-to-string (widget-get widget :value))))
 
 (defun widget-default-active (widget)

-  "Return t iff this widget active (user modifiable)."
+  "Return t if this widget is active (user modifiable)."

   (or (widget-get widget :always-active)
       (and (not (widget-get widget :inactive))
           (let ((parent (widget-get widget :parent)))
   (or (widget-get widget :always-active)
       (and (not (widget-get widget :inactive))
           (let ((parent (widget-get widget :parent)))


@@ -1759,7 +1769,7 @@ If END is omitted, it defaults to the length of LIST."
   "An embedded link."
   :button-prefix 'widget-link-prefix
   :button-suffix 'widget-link-suffix
   "An embedded link."
   :button-prefix 'widget-link-prefix
   :button-suffix 'widget-link-suffix

-  :follow-link "\C-m"
+  :follow-link 'mouse-face

   :help-echo "Follow the link."
   :format "%[%t%]")
 
   :help-echo "Follow the link."
   :format "%[%t%]")
 


@@ -3012,7 +3022,7 @@ as the value."
   :complete-function 'ispell-complete-word
   :prompt-history 'widget-string-prompt-value-history)
 
   :complete-function 'ispell-complete-word
   :prompt-history 'widget-string-prompt-value-history)
 

-(eval-when-compile (defvar widget))
+(defvar widget)

 
 (defun widget-string-complete ()
   "Complete contents of string field.
 
 (defun widget-string-complete ()
   "Complete contents of string field.


@@ -3031,7 +3041,7 @@ widget.  If that isn't a list, it's evalled and expected to yield a list."
             ;; Replace field with completion in case its case is different.
             (delete-region (widget-field-start widget)
                            (widget-field-end widget))
             ;; Replace field with completion in case its case is different.
             (delete-region (widget-field-start widget)
                            (widget-field-end widget))

-            (insert-and-inherit (car (assoc-ignore-case prefix alist))))
+            (insert-and-inherit (car (assoc-string prefix alist t))))

           (message "Only match"))
          ((null completion)
           (error "No match"))
           (message "Only match"))
          ((null completion)
           (error "No match"))


@@ -3290,7 +3300,7 @@ It reads a directory name from an editable text field."
       (setq unread-command-events (cons ev unread-command-events)
            ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix))
            tr nil)
       (setq unread-command-events (cons ev unread-command-events)
            ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix))
            tr nil)

-      (if (and (integerp ev) (not (char-valid-p ev)))
+      (if (and (integerp ev) (not (characterp ev)))

          (insert (char-to-string ev))))  ;; throw invalid char error
     (setq ev (key-description (list ev)))
     (when (arrayp tr)
          (insert (char-to-string ev))))  ;; throw invalid char error
     (setq ev (key-description (list ev)))
     (when (arrayp tr)


@@ -3730,7 +3740,8 @@ example:
   (require 'facemenu)                  ; for facemenu-color-alist
   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
                                                 (point)))
   (require 'facemenu)                  ; for facemenu-color-alist
   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
                                                 (point)))

-        (list (or facemenu-color-alist (defined-colors)))
+        (list (or facemenu-color-alist
+                  (sort (defined-colors) 'string-lessp)))

         (completion (try-completion prefix list)))
     (cond ((eq completion t)
           (message "Exact match."))
         (completion (try-completion prefix list)))
     (cond ((eq completion t)
           (message "Exact match."))


@@ -3785,5 +3796,5 @@ example:
 
 (provide 'wid-edit)
 
 
 (provide 'wid-edit)
 

-;;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
+;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707

 ;;; wid-edit.el ends here
 ;;; wid-edit.el ends here