]> code.delx.au - gnu-emacs/blobdiff - lisp/wid-edit.el
(proced-sort): Declare it buffer-local.
[gnu-emacs] / lisp / wid-edit.el
index 26c77e1a172ea30b9f3a0832fff1b66373e5247d..5de5f2d9ab525a047b23b8f424bbbe14afe1079e 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007, 2008, 2009  Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF
@@ -9,10 +9,10 @@
 
 ;; 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
-;; 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
@@ -20,9 +20,7 @@
 ;; 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):
 
@@ -200,7 +198,7 @@ For a larger number of items, the minibuffer is used."
   :type 'integer)
 
 (defcustom widget-menu-minibuffer-flag nil
-  "*Control how to ask for a choice from the keyboard.
+  "Control how to ask for a choice from the keyboard.
 Non-nil means use the minibuffer;
 nil means read a single character."
   :group 'widgets
@@ -344,12 +342,16 @@ new value.")
         (or (not widget-field-add-space) (widget-get widget :size))))
     (if (functionp help-echo)
       (setq help-echo 'widget-mouse-help))
-    (when (= (char-before to) ?\n)
+    (when (and (> to (1+ from))
+              (= (char-before to) ?\n))
       ;; When the last character in the field is a newline, we want to
       ;; give it a `field' char-property of `boundary', which helps the
       ;; C-n/C-p act more naturally when entering/leaving the field.  We
-     ;; do this by making a small secondary overlay to contain just that
+      ;; do this by making a small secondary overlay to contain just that
       ;; one character.
+      ;; We DON'T do this if the field just consists of a newline, eg
+      ;; when specifying a character, since it breaks things (below
+      ;; does 1- to, which results in to = from).  Bug#2689.
       (let ((overlay (make-overlay (1- to) to nil t nil)))
        (overlay-put overlay 'field 'boundary)
         ;; We need the real field for tabbing.
@@ -601,7 +603,7 @@ respectively."
 ;;; 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."
@@ -664,11 +666,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)
-            (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)
@@ -862,7 +860,9 @@ button end points."
 
 ;;; 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
@@ -1773,7 +1773,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
-  :follow-link "\C-m"
+  :follow-link 'mouse-face
   :help-echo "Follow the link."
   :format "%[%t%]")
 
@@ -1949,7 +1949,9 @@ the earlier input."
          (set-buffer buffer)
          (while (and size
                      (not (zerop size))
-                     (> to from)
+                     ;; Bug#2689.  Don't allow this loop to reduce a
+                     ;; character field to zero size if it contains a space.
+                     (> to (1+ from))
                      (eq (char-after (1- to)) ?\s))
            (setq to (1- to)))
          (let ((result (buffer-substring-no-properties from to)))
@@ -3026,7 +3028,7 @@ as the value."
   :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.
@@ -3049,7 +3051,7 @@ widget.  If that isn't a list, it's evalled and expected to yield a list."
           (message "Only match"))
          ((null completion)
           (error "No match"))
-         ((not (eq t (compare-strings prefix nil nil completion nil nil 
+         ((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.
@@ -3454,7 +3456,8 @@ To use this type, you must define :match or :match-alternatives."
   :value 0
   :size 1
   :format "%{%t%}: %v\n"
-  :valid-regexp "\\`.\\'"
+  ;; `.' does not match newline, but newline is a valid character.
+  :valid-regexp "\\`\\(.\\|\n\\)\\'"
   :error "This field should contain a single character"
   :value-to-internal (lambda (widget value)
                       (if (stringp value)
@@ -3744,7 +3747,8 @@ example:
   (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."))
@@ -3799,5 +3803,5 @@ example:
 
 (provide 'wid-edit)
 
-;;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
+;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
 ;;; wid-edit.el ends here