Update copyright notices for 2013.

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

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index b0d0024..5402b0e 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,6 +1,6 @@
 ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
 ;;
 ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
 ;;

-;; Copyright (C) 1996-1997, 1999-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.

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


@@ -295,10 +295,10 @@ minibuffer."
             (error "Canceled"))
           value))))
 
             (error "Canceled"))
           value))))
 

-(defun widget-remove-if (predictate list)
+(defun widget-remove-if (predicate list)

   (let (result (tail list))
     (while tail
   (let (result (tail list))
     (while tail

-      (or (funcall predictate (car tail))
+      (or (funcall predicate (car tail))

          (setq result (cons (car tail) result)))
       (setq tail (cdr tail)))
     (nreverse result)))
          (setq result (cons (car tail) result)))
       (setq tail (cdr tail)))
     (nreverse result)))


@@ -577,7 +577,7 @@ This is only meaningful for radio buttons or checkboxes in a list."
   "Map FUNCTION over the buttons in BUFFER.
 FUNCTION is called with the arguments WIDGET and MAPARG.
 
   "Map FUNCTION over the buttons in BUFFER.
 FUNCTION is called with the arguments WIDGET and MAPARG.
 

-If FUNCTION returns non-nil, the walk is cancelled.
+If FUNCTION returns non-nil, the walk is canceled.

 
 The arguments MAPARG, and BUFFER default to nil and (current-buffer),
 respectively."
 
 The arguments MAPARG, and BUFFER default to nil and (current-buffer),
 respectively."


@@ -1141,12 +1141,6 @@ the field."
        (kill-region (point) end)
       (call-interactively 'kill-line))))
 
        (kill-region (point) end)
       (call-interactively 'kill-line))))
 

-(defcustom widget-complete-field (lookup-key global-map "\M-\t")
-  "Default function to call for completion inside fields."
-  :options '(ispell-complete-word complete-tag lisp-complete-symbol)
-  :type 'function
-  :group 'widgets)
-

 (defun widget-narrow-to-field ()
   "Narrow to field."
   (interactive)
 (defun widget-narrow-to-field ()
   "Narrow to field."
   (interactive)


@@ -1169,10 +1163,6 @@ When not inside a field, signal an error."
         (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
                               (plist-get completion-extra-properties
                                          :predicate))))
         (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
                               (plist-get completion-extra-properties
                                          :predicate))))

-     ((widget-field-find (point))
-      ;; This defaulting used to be performed in widget-default-complete, but
-      ;; it seems more appropriate here than in widget-default-completions.
-      (call-interactively 'widget-complete-field))

      (t
       (error "Not in an editable field")))))
 ;; We may want to use widget completion in buffers where the major mode
      (t
       (error "Not in an editable field")))))
 ;; We may want to use widget completion in buffers where the major mode


@@ -1687,7 +1677,7 @@ The value of the :type attribute should be an unconverted widget type."
   (eval-minibuffer prompt))
 
 (defun widget-docstring (widget)
   (eval-minibuffer prompt))
 
 (defun widget-docstring (widget)

-  "Return the documentation string specificied by WIDGET, or nil if none.
+  "Return the documentation string specified by WIDGET, or nil if none.

 If WIDGET has a `:doc' property, that specifies the documentation string.
 Otherwise, try the `:documentation-property' property.  If this
 is a function, call it with the widget's value as an argument; if
 If WIDGET has a `:doc' property, that specifies the documentation string.
 Otherwise, try the `:documentation-property' property.  If this
 is a function, call it with the widget's value as an argument; if


@@ -1987,10 +1977,14 @@ the earlier input."
     (when (overlayp overlay)
       (delete-overlay overlay))))
 
     (when (overlayp overlay)
       (delete-overlay overlay))))
 

-(defun widget-field-value-get (widget)
-  "Return current text in editing field."
+(defun widget-field-value-get (widget &optional no-truncate)
+  "Return current text in editing field.
+Normally, trailing spaces within the editing field are truncated.
+But if NO-TRUNCATE is non-nil, include them."

   (let ((from (widget-field-start widget))
   (let ((from (widget-field-start widget))

-       (to (widget-field-text-end widget))
+       (to   (if no-truncate
+                 (widget-field-end widget)
+               (widget-field-text-end widget)))

        (buffer (widget-field-buffer widget))
        (secret (widget-get widget :secret))
        (old (current-buffer)))
        (buffer (widget-field-buffer widget))
        (secret (widget-get widget :secret))
        (old (current-buffer)))


@@ -2363,7 +2357,7 @@ Return an alist of (TYPE MATCH)."
     result))
 
 (defun widget-checklist-validate (widget)
     result))
 
 (defun widget-checklist-validate (widget)

-  ;; Ticked chilren must be valid.
+  ;; Ticked children must be valid.

   (let ((children (widget-get widget :children))
        child button found)
     (while (and children (not found))
   (let ((children (widget-get widget :children))
        child button found)
     (while (and children (not found))


@@ -2913,15 +2907,7 @@ link for that string."
              (push (widget-convert-button widget-documentation-link-type
                                           begin end :value name)
                    buttons)))))
              (push (widget-convert-button widget-documentation-link-type
                                           begin end :value name)
                    buttons)))))

-      (widget-put widget :buttons buttons)))
-  (let ((indent (widget-get widget :indent)))
-    (when (and indent (not (zerop indent)))
-      (save-excursion
-       (save-restriction
-         (narrow-to-region from to)
-         (goto-char (point-min))
-         (while (search-forward "\n" nil t)
-           (insert-char ?\s indent)))))))
+      (widget-put widget :buttons buttons))))

 
 ;;; The `documentation-string' Widget.
 
 
 ;;; The `documentation-string' Widget.
 


@@ -2940,10 +2926,9 @@ link for that string."
        (start (point)))
     (if (string-match "\n" doc)
        (let ((before (substring doc 0 (match-beginning 0)))
        (start (point)))
     (if (string-match "\n" doc)
        (let ((before (substring doc 0 (match-beginning 0)))

-             (after (substring doc (match-beginning 0)))
-             button)
-         (when (and indent (not (zerop indent)))
-           (insert-char ?\s indent))
+             (after (substring doc (match-end 0)))
+             button end)
+         (widget-documentation-string-indent-to indent)

          (insert before ?\s)
          (widget-documentation-link-add widget start (point))
          (setq button
          (insert before ?\s)
          (widget-documentation-link-add widget start (point))
          (setq button


@@ -2956,18 +2941,35 @@ link for that string."
                 :action 'widget-parent-action
                 shown))
          (when shown
                 :action 'widget-parent-action
                 shown))
          (when shown

+           (insert ?\n)

            (setq start (point))
            (when (and indent (not (zerop indent)))
              (insert-char ?\s indent))
            (insert after)
            (setq start (point))
            (when (and indent (not (zerop indent)))
              (insert-char ?\s indent))
            (insert after)

-           (widget-documentation-link-add widget start (point)))
+           (setq end (point))
+           (widget-documentation-link-add widget start end)
+           ;; Indent the subsequent lines.
+           (when (and indent (> indent 0))
+             (save-excursion
+               (save-restriction
+                 (narrow-to-region start end)
+                 (goto-char (point-min))
+                 (while (search-forward "\n" nil t)
+                   (widget-documentation-string-indent-to indent))))))

          (widget-put widget :buttons (list button)))
          (widget-put widget :buttons (list button)))

-      (when (and indent (not (zerop indent)))
-       (insert-char ?\s indent))
+      (widget-documentation-string-indent-to indent)

       (insert doc)
       (widget-documentation-link-add widget start (point))))
   (insert ?\n))
 
       (insert doc)
       (widget-documentation-link-add widget start (point))))
   (insert ?\n))
 

+(defun widget-documentation-string-indent-to (col)
+  (when (and (numberp col)
+            (> col 0))
+    (let ((opoint (point)))
+      (indent-to col)
+      (put-text-property opoint (point)
+                        'display `(space :align-to ,col)))))
+

 (defun widget-documentation-string-action (widget &rest _ignore)
   ;; Toggle documentation.
   (let ((parent (widget-get widget :parent)))
 (defun widget-documentation-string-action (widget &rest _ignore)
   ;; Toggle documentation.
   (let ((parent (widget-get widget :parent)))


@@ -3407,6 +3409,7 @@ To use this type, you must define :match or :match-alternatives."
   :format "%{%t%}: %v\n"
   :valid-regexp "\\`.\\'"
   :error "This field should contain a single character"
   :format "%{%t%}: %v\n"
   :valid-regexp "\\`.\\'"
   :error "This field should contain a single character"

+  :value-get (lambda (w) (widget-field-value-get w t))

   :value-to-internal (lambda (_widget value)
                       (if (stringp value)
                           value
   :value-to-internal (lambda (_widget value)
                       (if (stringp value)
                           value