Command substitution already runs in a subshell

[gnu-emacs] / lisp / wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 7b7813db94b3f5409ee7e9c15fff1b21a82cbb10..9c5c6462bcc2295cd6c95205722f181e5a51f962 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;-*-
+;;; 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-2012  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)


@@ -1161,10 +1155,25 @@ the field."
   "Complete content of editable field from point.
 When not inside a field, signal an error."
   (interactive)
   "Complete content of editable field from point.
 When not inside a field, signal an error."
   (interactive)

+  (let ((data (widget-completions-at-point)))
+    (cond
+     ((functionp data) (funcall data))
+     ((consp data)
+      (let ((completion-extra-properties (nth 3 data)))
+        (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+                              (plist-get completion-extra-properties
+                                         :predicate))))
+     (t
+      (error "Not in an editable field")))))
+;; We may want to use widget completion in buffers where the major mode
+;; hasn't added widget-completions-at-point to completion-at-point-functions,
+;; so it's not really obsolete (yet).
+;; (make-obsolete 'widget-complete 'completion-at-point "24.1")
+
+(defun widget-completions-at-point ()

   (let ((field (widget-field-find (point))))
   (let ((field (widget-field-find (point))))

-    (if field
-       (widget-apply field :complete)
-      (error "Not in an editable field"))))
+    (when field
+      (widget-apply field :completions-function))))

 
 ;;; Setting up the buffer.
 
 
 ;;; Setting up the buffer.
 


@@ -1435,7 +1444,7 @@ The value of the :type attribute should be an unconverted widget type."
   :value-to-external (lambda (_widget value) value)
   :button-prefix 'widget-button-prefix
   :button-suffix 'widget-button-suffix
   :value-to-external (lambda (_widget value) value)
   :button-prefix 'widget-button-prefix
   :button-suffix 'widget-button-suffix

-  :complete 'widget-default-complete
+  :completions-function #'widget-default-completions

   :create 'widget-default-create
   :indent nil
   :offset 0
   :create 'widget-default-create
   :indent nil
   :offset 0


@@ -1461,13 +1470,20 @@ The value of the :type attribute should be an unconverted widget type."
 
 (defvar widget--completing-widget)
 
 
 (defvar widget--completing-widget)
 

-(defun widget-default-complete (widget)
-  "Call the value of the :complete-function property of WIDGET.
-If that does not exist, call the value of `widget-complete-field'.
-During this call, `widget--completing-widget' is bound to WIDGET."
-  (let ((widget--completing-widget widget))
-    (call-interactively (or (widget-get widget :complete-function)
-                           widget-complete-field))))
+(defun widget-default-completions (widget)
+  "Return completion data, like `completion-at-point-functions' would."
+  (let ((completions (widget-get widget :completions)))
+    (if completions
+        (list (widget-field-start widget)
+              (max (point) (widget-field-text-end widget))
+              completions)
+      (if (widget-get widget :complete)
+          (lambda () (widget-apply widget :complete))
+        (if (widget-get widget :complete-function)
+            (lambda ()
+              (let ((widget--completing-widget widget))
+                (call-interactively
+                 (widget-get widget :complete-function)))))))))

 
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."
 
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."


@@ -1661,7 +1677,7 @@ During this call, `widget--completing-widget' is bound to WIDGET."
   (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


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


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


@@ -2887,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.
 


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


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


@@ -3018,20 +3046,6 @@ 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)
 

-(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* ((widget widget--completing-widget)
-        (completion-ignore-case (widget-get widget :completion-ignore-case))
-        (alist (widget-get widget :completion-alist))
-        (_ (unless (listp alist)
-             (setq alist (eval alist)))))
-    (completion-in-region (widget-field-start widget)
-                          (max (point) (widget-field-text-end widget))
-                          alist)))
-

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


@@ -3059,21 +3073,13 @@ widget.  If that isn't a list, it's evalled and expected to yield a list."
 (define-widget 'file 'string
   "A file widget.
 It reads a file name from an editable text field."
 (define-widget 'file 'string
   "A file widget.
 It reads a file name from an editable text field."

-  :complete-function 'widget-file-complete
+  :completions #'completion-file-name-table

   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"
   ;; Doesn't work well with terminating newline.
   ;; :value-face 'widget-single-line-field
   :tag "File")
 
   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"
   ;; Doesn't work well with terminating newline.
   ;; :value-face 'widget-single-line-field
   :tag "File")
 

-(defun widget-file-complete ()
-  "Perform completion on file name preceding point."
-  (interactive)
-  (let ((widget widget--completing-widget))
-    (completion-in-region (widget-field-start widget)
-                         (max (point) (widget-field-text-end widget))
-                         'completion-file-name-table)))
-

 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.
   (abbreviate-file-name
 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.
   (abbreviate-file-name


@@ -3113,7 +3119,7 @@ It reads a directory name from an editable text field."
   :tag "Symbol"
   :format "%{%t%}: %v"
   :match (lambda (_widget value) (symbolp value))
   :tag "Symbol"
   :format "%{%t%}: %v"
   :match (lambda (_widget value) (symbolp value))

-  :complete-function 'lisp-complete-symbol
+  :completions obarray

   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'symbolp
   :prompt-history 'widget-symbol-prompt-value-history
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'symbolp
   :prompt-history 'widget-symbol-prompt-value-history


@@ -3141,9 +3147,8 @@ It reads a directory name from an editable text field."
 
 (define-widget 'function 'restricted-sexp
   "A Lisp function."
 
 (define-widget 'function 'restricted-sexp
   "A Lisp function."

-  :complete-function (lambda ()
-                      (interactive)
-                      (lisp-complete-symbol 'fboundp))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'fboundp 'strict)

   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'fboundp
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'fboundp


@@ -3165,9 +3170,8 @@ It reads a directory name from an editable text field."
   "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
   "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history

-  :complete-function (lambda ()
-                      (interactive)
-                      (lisp-complete-symbol 'boundp))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'boundp 'strict)

   :tag "Variable")
 
 (define-widget 'coding-system 'symbol
   :tag "Variable")
 
 (define-widget 'coding-system 'symbol


@@ -3178,9 +3182,8 @@ It reads a directory name from an editable text field."
   :prompt-history 'coding-system-value-history
   :prompt-value 'widget-coding-system-prompt-value
   :action 'widget-coding-system-action
   :prompt-history 'coding-system-value-history
   :prompt-value 'widget-coding-system-prompt-value
   :action 'widget-coding-system-action

-  :complete-function (lambda ()
-                      (interactive)
-                      (lisp-complete-symbol 'coding-system-p))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'coding-system-p 'strict)

   :validate (lambda (widget)
              (unless (coding-system-p (widget-value widget))
                (widget-put widget :error (format "Invalid coding system: %S"
   :validate (lambda (widget)
              (unless (coding-system-p (widget-value widget))
                (widget-put widget :error (format "Invalid coding system: %S"


@@ -3317,7 +3320,7 @@ It reads a directory name from an editable text field."
     (insert (widget-apply widget :value-get))
     (goto-char (point-min))
     (let (err)
     (insert (widget-apply widget :value-get))
     (goto-char (point-min))
     (let (err)

-      (condition-case data
+      (condition-case data ;Note: We get a spurious byte-compile warning here.

          (progn
            ;; Avoid a confusing end-of-file error.
            (skip-syntax-forward "\\s-")
          (progn
            ;; Avoid a confusing end-of-file error.
            (skip-syntax-forward "\\s-")


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


@@ -3685,7 +3689,7 @@ example:
   :size 10
   :tag "Color"
   :value "black"
   :size 10
   :tag "Color"
   :value "black"

-  :complete 'widget-color-complete
+  :completions (or facemenu-color-alist (defined-colors))

   :sample-face-get 'widget-color-sample-face-get
   :notify 'widget-color-notify
   :action 'widget-color-action)
   :sample-face-get 'widget-color-sample-face-get
   :notify 'widget-color-notify
   :action 'widget-color-action)


@@ -3711,14 +3715,6 @@ example:
               (delete-window win)))
        (pop-to-buffer ,(current-buffer))))))
 
               (delete-window win)))
        (pop-to-buffer ,(current-buffer))))))
 

-(defun widget-color-complete (widget)
-  "Complete the color in WIDGET."
-  (require 'facemenu)                  ; for facemenu-color-alist
-  (completion-in-region (widget-field-start widget)
-                        (max (point) (widget-field-text-end widget))
-                        (or facemenu-color-alist
-                            (sort (defined-colors) 'string-lessp))))
-

 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil
                    (widget-value widget)
 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil
                    (widget-value widget)