* calendar/todo-mode.el (todo-set-top-priorities): Fix logic to

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

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 2792232..a857407 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,9 +1,9 @@
 ;;; 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-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2014 Free Software Foundation, Inc.

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

-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org

 ;; Keywords: extensions
 ;; Package: emacs
 
 ;; Keywords: extensions
 ;; Package: emacs
 


@@ -55,6 +55,7 @@
 ;; See `widget.el'.
 
 ;;; Code:
 ;; See `widget.el'.
 
 ;;; Code:

+(require 'cl-lib)

 
 ;;; Compatibility.
 
 
 ;;; Compatibility.
 


@@ -221,7 +222,7 @@ minibuffer."
        ((or widget-menu-minibuffer-flag
             (> (length items) widget-menu-max-shortcuts))
         ;; Read the choice of name from the minibuffer.
        ((or widget-menu-minibuffer-flag
             (> (length items) widget-menu-max-shortcuts))
         ;; Read the choice of name from the minibuffer.

-        (setq items (widget-remove-if 'stringp items))
+        (setq items (cl-remove-if 'stringp items))

         (let ((val (completing-read (concat title ": ") items nil t)))
           (if (stringp val)
               (let ((try (try-completion val items)))
         (let ((val (completing-read (concat title ": ") items nil t)))
           (if (stringp val)
               (let ((try (try-completion val items)))


@@ -295,14 +296,6 @@ minibuffer."
             (error "Canceled"))
           value))))
 
             (error "Canceled"))
           value))))
 

-(defun widget-remove-if (predicate list)
-  (let (result (tail list))
-    (while tail
-      (or (funcall predicate (car tail))
-         (setq result (cons (car tail) result)))
-      (setq tail (cdr tail)))
-    (nreverse result)))
-

 ;;; Widget text specifications.
 ;;
 ;; These functions are for specifying text properties.
 ;;; Widget text specifications.
 ;;
 ;; These functions are for specifying text properties.


@@ -526,7 +519,17 @@ Otherwise, just return the value."
   "Extract the default external value of WIDGET."
   (widget-apply widget :value-to-external
                (or (widget-get widget :value)
   "Extract the default external value of WIDGET."
   (widget-apply widget :value-to-external
                (or (widget-get widget :value)

-                   (widget-apply widget :default-get))))
+                   (progn
+                     (when (widget-get widget :args)
+                       (setq widget (widget-copy widget))
+                       (let (args)
+                         (dolist (arg (widget-get widget :args))
+                           (setq args (append args
+                                              (if (widget-get arg :inline)
+                                                  (widget-get arg :args)
+                                                (list arg)))))
+                         (widget-put widget :args args)))
+                     (widget-apply widget :default-get)))))

 
 (defun widget-match-inline (widget vals)
   "In WIDGET, match the start of VALS."
 
 (defun widget-match-inline (widget vals)
   "In WIDGET, match the start of VALS."


@@ -1141,12 +1144,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 +1166,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


@@ -1987,10 +1980,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)))


@@ -2913,15 +2910,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 +2929,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 +2944,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 +3412,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


@@ -3456,14 +3462,14 @@ To use this type, you must define :match or :match-alternatives."
 ;; Recursive datatypes.
 
 (define-widget 'lazy 'default
 ;; Recursive datatypes.
 
 (define-widget 'lazy 'default

-  "Base widget for recursive datastructures.
+  "Base widget for recursive data structures.

 
 The `lazy' widget will, when instantiated, contain a single inferior
 widget, of the widget type specified by the :type parameter.  The
 value of the `lazy' widget is the same as the value of the inferior
 widget.  When deriving a new widget from the 'lazy' widget, the :type
 parameter is allowed to refer to the widget currently being defined,
 
 The `lazy' widget will, when instantiated, contain a single inferior
 widget, of the widget type specified by the :type parameter.  The
 value of the `lazy' widget is the same as the value of the inferior
 widget.  When deriving a new widget from the 'lazy' widget, the :type
 parameter is allowed to refer to the widget currently being defined,

-thus allowing recursive datastructures to be described.
+thus allowing recursive data structures to be described.

 
 The :type parameter takes the same arguments as the defcustom
 parameter with the same name.
 
 The :type parameter takes the same arguments as the defcustom
 parameter with the same name.


@@ -3473,7 +3479,7 @@ not allow recursion.  That is, when you define a new widget type, none
 of the inferior widgets may be of the same type you are currently
 defining.
 
 of the inferior widgets may be of the same type you are currently
 defining.
 

-In Lisp, however, it is custom to define datastructures in terms of
+In Lisp, however, it is custom to define data structures in terms of

 themselves.  A list, for example, is defined as either nil, or a cons
 cell whose cdr itself is a list.  The obvious way to translate this
 into a widget type would be
 themselves.  A list, for example, is defined as either nil, or a cons
 cell whose cdr itself is a list.  The obvious way to translate this
 into a widget type would be


@@ -3496,7 +3502,7 @@ example:
     :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
   :format "%{%t%}: %v"
   ;; We don't convert :type because we want to allow recursive
     :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
   :format "%{%t%}: %v"
   ;; We don't convert :type because we want to allow recursive

-  ;; datastructures.  This is slow, so we should not create speed
+  ;; data structures.  This is slow, so we should not create speed

   ;; critical widgets by deriving from this.
   :convert-widget 'widget-value-convert-widget
   :value-create 'widget-type-value-create
   ;; critical widgets by deriving from this.
   :convert-widget 'widget-value-convert-widget
   :value-create 'widget-type-value-create