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 49d519a..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):
 


@@ -488,7 +486,7 @@ 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
   (car widget))
 
 ;;;###autoload


@@ -601,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."


@@ -664,11 +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
-                            ;; Use a `list' so it's unique and won't get
-                            ;; accidentally merged with neighbouring images.
-                           tag 'mouse-face (list widget-button-pressed-face))))
+            (insert-image image tag))

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


@@ -862,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


@@ -874,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.")


@@ -1450,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)))
 


@@ -1771,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%]")
 


@@ -3024,6 +3022,43 @@ 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)
 

+(defvar widget)
+
+(defun widget-string-complete ()
+  "Complete contents of string field.
+Completions are taken from the :completion-alist property of the
+widget.  If that isn't a list, it's evalled and expected to yield a list."
+  (interactive)
+  (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
+                                                (point)))
+        (completion-ignore-case (widget-get widget :completion-ignore-case))
+        (alist (widget-get widget :completion-alist))
+        (_ (unless (listp alist)
+             (setq alist (eval alist))))
+        (completion (try-completion prefix alist)))
+    (cond ((eq completion t)
+          (when completion-ignore-case
+            ;; 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-string prefix alist t))))
+          (message "Only match"))
+         ((null completion)
+          (error "No match"))
+         ((not (eq t (compare-strings prefix nil nil completion nil nil 
+                                      completion-ignore-case)))
+          (when completion-ignore-case
+            ;; Replace field with completion in case its case is different.
+            (delete-region (widget-field-start widget)
+                           (widget-field-end widget))
+            (insert-and-inherit completion)))
+         (t
+          (message "Making completion list...")
+          (with-output-to-temp-buffer "*Completions*"
+            (display-completion-list
+             (all-completions prefix alist nil)))
+          (message "Making completion list...done")))))
+

 (define-widget 'regexp 'string
   "A regular expression."
   :match 'widget-regexp-match
 (define-widget 'regexp 'string
   "A regular expression."
   :match 'widget-regexp-match


@@ -3180,16 +3215,13 @@ It reads a directory name from an editable text field."
                       (interactive)
                       (lisp-complete-symbol 'boundp))
   :tag "Variable")
                       (interactive)
                       (lisp-complete-symbol 'boundp))
   :tag "Variable")

-\f
-(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"
   :base-only nil
 
 (define-widget 'coding-system 'symbol
   "A MULE coding-system."
   :format "%{%t%}: %v"
   :tag "Coding system"
   :base-only nil

-  :prompt-history 'widget-coding-system-prompt-value-history
+  :prompt-history 'coding-system-value-history

   :prompt-value 'widget-coding-system-prompt-value
   :action 'widget-coding-system-action
   :complete-function (lambda ()
   :prompt-value 'widget-coding-system-prompt-value
   :action 'widget-coding-system-action
   :complete-function (lambda ()


@@ -3268,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)


@@ -3429,7 +3461,7 @@ To use this type, you must define :match or :match-alternatives."
                           (aref value 0)
                         value))
   :match (lambda (widget value)
                           (aref value 0)
                         value))
   :match (lambda (widget value)

-          (char-valid-p value)))
+          (characterp value)))

 
 (define-widget 'list 'group
   "A Lisp list."
 
 (define-widget 'list 'group
   "A Lisp list."


@@ -3708,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."))


@@ -3763,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