-;;; 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-2013 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
(error "Canceled"))
value))))
-(defun widget-remove-if (predictate list)
+(defun widget-remove-if (predicate list)
(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)))
(overlay-put overlay 'follow-link follow-link)
(overlay-put overlay 'help-echo help-echo)))
-(defun widget-mouse-help (window overlay point)
+(defun widget-mouse-help (_window overlay _point)
"Help-echo callback for widgets whose :help-echo is a function."
(with-current-buffer (overlay-buffer overlay)
(let* ((widget (widget-at (overlay-start overlay)))
(overlay-put overlay 'modification-hooks '(widget-overlay-inactive))
(widget-put widget :inactive overlay))))
-(defun widget-overlay-inactive (&rest junk)
+(defun widget-overlay-inactive (&rest _junk)
"Ignoring the arguments, signal an error."
(unless inhibit-read-only
(error "The widget here is not active")))
"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."
This exists as a variable so it can be set locally in certain
buffers.")
-(defun widget-image-insert (widget tag image &optional down inactive)
+(defun widget-image-insert (widget tag image &optional _down _inactive)
"In WIDGET, insert the text TAG or, if supported, IMAGE.
IMAGE should either be an image or an image file name sans extension
\(xpm, xbm, gif, jpg, or png) located in `widget-image-directory'.
(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)
"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))))
- (if field
- (widget-apply field :complete)
- (error "Not in an editable field"))))
+ (when field
+ (widget-apply field :completions-function))))
;;; Setting up the buffer.
(add-hook 'before-change-functions 'widget-before-change nil t)
(add-hook 'after-change-functions 'widget-after-change nil t))
-(defun widget-after-change (from to old)
+(defun widget-after-change (from to _old)
"Adjust field size and text properties."
(let ((field (widget-field-find from))
(other (widget-field-find to)))
(define-widget 'default nil
"Basic widget other widgets are derived from."
- :value-to-internal (lambda (widget value) value)
- :value-to-external (lambda (widget value) value)
+ :value-to-internal (lambda (_widget value) value)
+ :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
(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."
(widget-put widget :to to)))
(widget-clear-undo))
-(defun widget-default-format-handler (widget escape)
+(defun widget-default-format-handler (_widget escape)
(error "Unknown escape `%c'" escape))
(defun widget-default-button-face-get (widget)
(when parent
(widget-apply parent :notify widget event))))
-(defun widget-default-notify (widget child &optional event)
+(defun widget-default-notify (widget _child &optional event)
"Pass notification to parent."
(widget-default-action widget event))
-(defun widget-default-prompt-value (widget prompt value unbound)
+(defun widget-default-prompt-value (_widget prompt _value _unbound)
"Read an arbitrary value."
(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
;; Match if the value is the same.
(equal (widget-get widget :value) value))
-(defun widget-item-match-inline (widget values)
+(defun widget-item-match-inline (widget vals)
;; Match if the value is the same.
(let ((value (widget-get widget :value)))
(and (listp value)
- (<= (length value) (length values))
- (let ((head (widget-sublist values 0 (length value))))
+ (<= (length value) (length vals))
+ (let ((head (widget-sublist vals 0 (length value))))
(and (equal head value)
- (cons head (widget-sublist values (length value))))))))
+ (cons head (widget-sublist vals (length value))))))))
(defun widget-sublist (list start &optional end)
"Return the sublist of LIST from START to END.
"A link to an info file."
:action 'widget-info-link-action)
-(defun widget-info-link-action (widget &optional event)
+(defun widget-info-link-action (widget &optional _event)
"Open the info node specified by WIDGET."
(info (widget-value widget)))
"A link to an www page."
:action 'widget-url-link-action)
-(defun widget-url-link-action (widget &optional event)
+(defun widget-url-link-action (widget &optional _event)
"Open the URL specified by WIDGET."
(browse-url (widget-value widget)))
"A link to an Emacs function."
:action 'widget-function-link-action)
-(defun widget-function-link-action (widget &optional event)
+(defun widget-function-link-action (widget &optional _event)
"Show the function specified by WIDGET."
(describe-function (widget-value widget)))
"A link to an Emacs variable."
:action 'widget-variable-link-action)
-(defun widget-variable-link-action (widget &optional event)
+(defun widget-variable-link-action (widget &optional _event)
"Show the variable specified by WIDGET."
(describe-variable (widget-value widget)))
"A link to a file."
:action 'widget-file-link-action)
-(defun widget-file-link-action (widget &optional event)
+(defun widget-file-link-action (widget &optional _event)
"Find the file specified by WIDGET."
(find-file (widget-value widget)))
"A link to an Emacs Lisp library file."
:action 'widget-emacs-library-link-action)
-(defun widget-emacs-library-link-action (widget &optional event)
+(defun widget-emacs-library-link-action (widget &optional _event)
"Find the Emacs library file specified by WIDGET."
(find-file (locate-library (widget-value widget))))
"A link to Commentary in an Emacs Lisp library file."
:action 'widget-emacs-commentary-link-action)
-(defun widget-emacs-commentary-link-action (widget &optional event)
+(defun widget-emacs-commentary-link-action (widget &optional _event)
"Find the Commentary section of the Emacs file specified by WIDGET."
(finder-commentary (widget-value widget)))
(defvar widget-field-history nil
"History of field minibuffer edits.")
-(defun widget-field-prompt-internal (widget prompt initial history)
+(defun widget-field-prompt-internal (_widget prompt initial history)
"Read string for WIDGET prompting with PROMPT.
INITIAL is the initial input and HISTORY is a symbol containing
the earlier input."
(defvar widget-edit-functions nil)
-(defun widget-field-action (widget &optional event)
+(defun widget-field-action (widget &optional _event)
"Move to next field."
(widget-forward 1)
(run-hook-with-args 'widget-edit-functions widget))
"Set an editable text field WIDGET to VALUE"
(let ((from (widget-field-start widget))
(to (widget-field-text-end widget))
- (buffer (widget-field-buffer widget))
- (size (widget-get widget :size)))
+ (buffer (widget-field-buffer widget)))
(when (and from to (buffer-live-p buffer))
(with-current-buffer buffer
(goto-char from)
(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))
- (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)))
result))
(widget-get widget :value))))
-(defun widget-field-match (widget value)
+(defun widget-field-match (_widget value)
;; Match any string.
(stringp value))
:type 'boolean
:group 'widgets)
-(defun widget-choice-mouse-down-action (widget &optional event)
+(defun widget-choice-mouse-down-action (widget &optional _event)
;; Return non-nil if we need a menu.
(let ((args (widget-get widget :args))
(old (widget-get widget :choice)))
found (widget-apply current :match value)))
found))
-(defun widget-choice-match-inline (widget values)
+(defun widget-choice-match-inline (widget vals)
;; Matches if one of the choices matches.
(let ((args (widget-get widget :args))
current found)
(while (and args (null found))
(setq current (car args)
args (cdr args)
- found (widget-match-inline current values)))
+ found (widget-match-inline current vals)))
found))
;;; The `toggle' Widget.
:format "%[%v%]\n"
:value-create 'widget-toggle-value-create
:action 'widget-toggle-action
- :match (lambda (widget value) t)
+ :match (lambda (_widget _value) t)
:on "on"
:off "off")
(and button (widget-put widget :buttons (cons button buttons)))
(and child (widget-put widget :children (cons child children))))))
-(defun widget-checklist-match (widget values)
+(defun widget-checklist-match (widget vals)
;; All values must match a type in the checklist.
- (and (listp values)
- (null (cdr (widget-checklist-match-inline widget values)))))
+ (and (listp vals)
+ (null (cdr (widget-checklist-match-inline widget vals)))))
-(defun widget-checklist-match-inline (widget values)
+(defun widget-checklist-match-inline (widget vals)
;; Find the values which match a type in the checklist.
(let ((greedy (widget-get widget :greedy))
(args (copy-sequence (widget-get widget :args)))
found rest)
- (while values
- (let ((answer (widget-checklist-match-up args values)))
+ (while vals
+ (let ((answer (widget-checklist-match-up args vals)))
(cond (answer
- (let ((vals (widget-match-inline answer values)))
- (setq found (append found (car vals))
- values (cdr vals)
+ (let ((vals2 (widget-match-inline answer vals)))
+ (setq found (append found (car vals2))
+ vals (cdr vals2)
args (delq answer args))))
(greedy
- (setq rest (append rest (list (car values)))
- values (cdr values)))
+ (setq rest (append rest (list (car vals)))
+ vals (cdr vals)))
(t
- (setq rest (append rest values)
- values nil)))))
+ (setq rest (append rest vals)
+ vals nil)))))
(cons found rest)))
(defun widget-checklist-match-find (widget &optional vals)
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))
:off "( )"
:off-glyph "radio0")
-(defun widget-radio-button-notify (widget child &optional event)
+(defun widget-radio-button-notify (widget _child &optional event)
;; Tell daddy.
(widget-apply (widget-get widget :parent) :action widget event))
:help-echo "Insert a new item into the list at this position."
:action 'widget-insert-button-action)
-(defun widget-insert-button-action (widget &optional event)
+(defun widget-insert-button-action (widget &optional _event)
;; Ask the parent to insert a new item.
(widget-apply (widget-get widget :parent)
:insert-before (widget-get widget :widget)))
:help-echo "Delete this item from the list."
:action 'widget-delete-button-action)
-(defun widget-delete-button-action (widget &optional event)
+(defun widget-delete-button-action (widget &optional _event)
;; Ask the parent to insert a new item.
(widget-apply (widget-get widget :parent)
:delete-at (widget-get widget :widget)))
;; Get the default of the components.
(mapcar 'widget-default-get (widget-get widget :args)))
-(defun widget-group-match (widget values)
+(defun widget-group-match (widget vals)
;; Match if the components match.
- (and (listp values)
- (let ((match (widget-group-match-inline widget values)))
+ (and (listp vals)
+ (let ((match (widget-group-match-inline widget vals)))
(and match (null (cdr match))))))
(defun widget-group-match-inline (widget vals)
:off "Show"
:value-create 'widget-visibility-value-create
:action 'widget-toggle-action
- :match (lambda (widget value) t))
+ :match (lambda (_widget _value) t))
(defalias 'widget-visibility-value-create 'widget-toggle-value-create)
:help-echo "Describe this symbol"
:action 'widget-documentation-link-action)
-(defun widget-documentation-link-action (widget &optional event)
+(defun widget-documentation-link-action (widget &optional _event)
"Display documentation for WIDGET's value. Ignore optional argument EVENT."
(let* ((string (widget-get widget :value))
(symbol (intern string)))
(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.
(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
:action 'widget-parent-action
shown))
(when shown
+ (insert ?\n)
(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)))
- (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))
-(defun widget-documentation-string-action (widget &rest ignore)
+(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)))
(widget-put parent :documentation-shown
:prompt-value 'widget-const-prompt-value
:format "%t\n%d")
-(defun widget-const-prompt-value (widget prompt value unbound)
+(defun widget-const-prompt-value (widget _prompt _value _unbound)
;; Return the value of the const.
(widget-value widget))
: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
;; :value-face 'widget-single-line-field
:tag "Regexp")
-(defun widget-regexp-match (widget value)
+(defun widget-regexp-match (_widget value)
;; Match valid regexps.
(and (stringp value)
(condition-case nil
(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")
-(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
:value nil
:tag "Symbol"
:format "%{%t%}: %v"
- :match (lambda (widget value) (symbolp value))
- :complete-function 'lisp-complete-symbol
+ :match (lambda (_widget value) (symbolp value))
+ :completions obarray
:prompt-internal 'widget-symbol-prompt-internal
:prompt-match 'symbolp
:prompt-history 'widget-symbol-prompt-value-history
- :value-to-internal (lambda (widget value)
+ :value-to-internal (lambda (_widget value)
(if (symbolp value)
(symbol-name value)
value))
- :value-to-external (lambda (widget value)
+ :value-to-external (lambda (_widget value)
(if (stringp value)
(intern value)
value)))
(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
"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
: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"
:value 'undecided
:prompt-match 'coding-system-p)
-(defun widget-coding-system-prompt-value (widget prompt value unbound)
+(defun widget-coding-system-prompt-value (widget prompt value _unbound)
"Read coding-system from minibuffer."
(if (widget-get widget :base-only)
(intern
(key-description value))
value))
-(defun widget-key-sequence-value-to-external (widget value)
+(defun widget-key-sequence-value-to-external (_widget value)
(if (stringp value)
(if (string-match "\\`[[:space:]]*\\'" value)
widget-key-sequence-default-value
:format "%{%t%}: %v"
:value nil
:validate 'widget-sexp-validate
- :match (lambda (widget value) t)
+ :match (lambda (_widget _value) t)
:value-to-internal 'widget-sexp-value-to-internal
- :value-to-external (lambda (widget value) (read value))
+ :value-to-external (lambda (_widget value) (read value))
:prompt-history 'widget-sexp-prompt-value-history
:prompt-value 'widget-sexp-prompt-value)
-(defun widget-sexp-value-to-internal (widget value)
+(defun widget-sexp-value-to-internal (_widget value)
;; Use pp for printer representation.
(let ((pp (if (symbolp value)
(prin1-to-string value)
(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-")
:format "%{%t%}: %v\n"
:valid-regexp "\\`.\\'"
:error "This field should contain a single character"
- :value-to-internal (lambda (widget value)
+ :value-get (lambda (w) (widget-field-value-get w t))
+ :value-to-internal (lambda (_widget value)
(if (stringp value)
value
(char-to-string value)))
- :value-to-external (lambda (widget value)
+ :value-to-external (lambda (_widget value)
(if (stringp value)
(aref value 0)
value))
- :match (lambda (widget value)
+ :match (lambda (_widget value)
(characterp value)))
(define-widget 'list 'group
:tag "Vector"
:format "%{%t%}:\n%v"
:match 'widget-vector-match
- :value-to-internal (lambda (widget value) (append value nil))
- :value-to-external (lambda (widget value) (apply 'vector value)))
+ :value-to-internal (lambda (_widget value) (append value nil))
+ :value-to-external (lambda (_widget value) (apply 'vector value)))
(defun widget-vector-match (widget value)
(and (vectorp value)
:tag "Cons-cell"
:format "%{%t%}:\n%v"
:match 'widget-cons-match
- :value-to-internal (lambda (widget value)
+ :value-to-internal (lambda (_widget value)
(list (car value) (cdr value)))
- :value-to-external (lambda (widget value)
+ :value-to-external (lambda (_widget value)
(apply 'cons value)))
(defun widget-cons-match (widget value)
:button-suffix 'widget-push-button-suffix
:prompt-value 'widget-choice-prompt-value)
-(defun widget-choice-prompt-value (widget prompt value unbound)
+(defun widget-choice-prompt-value (widget prompt value _unbound)
"Make a choice."
(let ((args (widget-get widget :args))
(completion-ignore-case (widget-get widget :case-fold))
:on "on (non-nil)"
:off "off (nil)")
-(defun widget-boolean-prompt-value (widget prompt value unbound)
+(defun widget-boolean-prompt-value (_widget prompt _value _unbound)
;; Toggle a boolean.
(y-or-n-p prompt))
\f
: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)
:tag " Choose " :action 'widget-color--choose-action)
(widget-insert " "))
-(defun widget-color--choose-action (widget &optional event)
+(defun widget-color--choose-action (widget &optional _event)
(list-colors-display
nil nil
`(lambda (color)
(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)
"Prompt for a color."
(let* ((tag (widget-apply widget :menu-tag-get))
(prompt (concat tag ": "))
- (value (widget-value widget))
- (start (widget-field-start widget))
(answer (facemenu-read-color prompt)))
(unless (zerop (length answer))
(widget-value-set widget answer)
HCoop / bpt / emacs.git / blobdiff