:group 'widgets
:type 'integer)
-(defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version)
+(defcustom widget-menu-max-shortcuts 40
+ "Largest number of items for which it works to choose one with a character.
+For a larger number of items, the minibuffer is used."
+ :group 'widgets
+ :type 'integer)
+
+(defcustom widget-menu-minibuffer-flag nil
"*Control how to ask for a choice from the keyboard.
Non-nil means use the minibuffer;
nil means read a single character."
;; We are in Emacs-19, pressed by the mouse
(x-popup-menu event
(list title (cons "" items))))
- (widget-menu-minibuffer-flag
+ ((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))
(let ((val (completing-read (concat title ": ") items nil t)))
(overlay-put overlay 'keymap map)
(overlay-put overlay 'face face)
(overlay-put overlay 'balloon-help help-echo)
- (overlay-put overlay 'help-echo help-echo)))
+ (overlay-put overlay 'help-echo help-echo))
+ (widget-specify-secret widget))
+
+(defun widget-specify-secret (field)
+ "Replace text in FIELD with value of `:secret', if non-nil."
+ (let ((secret (widget-get field :secret))
+ (size (widget-get field :size)))
+ (when secret
+ (let ((begin (widget-field-start field))
+ (end (widget-field-end field)))
+ (when size
+ (while (and (> end begin)
+ (eq (char-after (1- end)) ?\ ))
+ (setq end (1- end))))
+ (while (< begin end)
+ (let ((old (char-after begin)))
+ (unless (eq old secret)
+ (subst-char-in-region begin (1+ begin) old secret)
+ (put-text-property begin (1+ begin) 'secret old))
+ (setq begin (1+ begin))))))))
(defun widget-specify-button (widget from to)
"Specify button for WIDGET between FROM and TO."
:value-set (widget-apply widget
:value-to-internal value)))
+(defun widget-default-get (widget)
+ "Extract the default value of WIDGET."
+ (or (widget-get widget :value)
+ (widget-apply widget :default-get)))
+
(defun widget-match-inline (widget vals)
;; In WIDGET, match the start of VALS.
(cond ((widget-get widget :inline)
"Go to beginning of field or beginning of line, whichever is first."
(interactive)
(let* ((field (widget-field-find (point)))
- (start (and field (widget-field-start field))))
- (if (and start (not (eq start (point))))
- (goto-char start)
- (call-interactively 'beginning-of-line))))
+ (start (and field (widget-field-start field)))
+ (bol (save-excursion
+ (beginning-of-line)
+ (point))))
+ (goto-char (if start
+ (max start bol)
+ bol))))
(defun widget-end-of-line ()
"Go to end of field or end of line, whichever is first."
(interactive)
(let* ((field (widget-field-find (point)))
- (end (and field (widget-field-end field))))
- (if (and end (not (eq end (point))))
- (goto-char end)
- (call-interactively 'end-of-line))))
+ (end (and field (widget-field-end field)))
+ (eol (save-excursion
+ (end-of-line)
+ (point))))
+ (goto-char (if end
+ (min end eol)
+ eol))))
(defun widget-kill-line ()
"Kill to end of field or end of line, whichever is first."
(when field
(unless (eq field other)
(debug "Change in different fields"))
- (let ((size (widget-get field :size))
- (secret (widget-get field :secret)))
+ (let ((size (widget-get field :size)))
(when size
(let ((begin (widget-field-start field))
(end (widget-field-end field)))
(while (and (eq (preceding-char) ?\ )
(> (point) begin))
(delete-backward-char 1)))))))
- (when secret
- (let ((begin (widget-field-start field))
- (end (widget-field-end field)))
- (when size
- (while (and (> end begin)
- (eq (char-after (1- end)) ?\ ))
- (setq end (1- end))))
- (while (< begin end)
- (let ((old (char-after begin)))
- (unless (eq old secret)
- (subst-char-in-region begin (1+ begin) old secret)
- (put-text-property begin (1+ begin) 'secret old))
- (setq begin (1+ begin)))))))
+ (widget-specify-secret field))
(widget-apply field :notify field)))
(error (debug "After Change"))))
:delete 'widget-default-delete
:value-set 'widget-default-value-set
:value-inline 'widget-default-value-inline
+ :default-get 'widget-default-default-get
:menu-tag-get 'widget-default-menu-tag-get
:validate (lambda (widget) nil)
:active 'widget-default-active
(widget-value widget)
(list (widget-value widget))))
+(defun widget-default-default-get (widget)
+ ;; Get `:value'.
+ (widget-get widget :value))
+
(defun widget-default-menu-tag-get (widget)
;; Use tag or value for menus.
(or (widget-get widget :menu-tag)
:value-delete 'widget-children-value-delete
:value-get 'widget-choice-value-get
:value-inline 'widget-choice-value-inline
+ :default-get 'widget-choice-default-get
:mouse-down-action 'widget-choice-mouse-down-action
:action 'widget-choice-action
:error "Make a choice"
;; Get value of the child widget.
(widget-apply (car (widget-get widget :children)) :value-inline))
+(defun widget-choice-default-get (widget)
+ ;; Get default for the first choice.
+ (widget-default-get (car (widget-get widget :args))))
+
(defcustom widget-choice-toggle nil
"If non-nil, a binary choice will just toggle between the values.
Otherwise, the user will explicitly have to choose between the values
(when this-explicit
(widget-put widget :explicit-choice current)
(widget-put widget :explicit-choice-value (widget-get widget :value)))
- (widget-value-set widget
- (widget-apply current :value-to-external
- (widget-get current :value)))
+ (let ((value (widget-default-get current)))
+ (widget-value-set widget
+ (widget-apply current :value-to-external value)))
(widget-setup)
(widget-apply widget :notify widget event)))
(run-hook-with-args 'widget-edit-functions widget))
(if conv
(setq child (widget-create-child-value
widget type value))
- (setq child (widget-create-child widget type))))
+ (setq child (widget-create-child-value
+ widget type
+ (widget-apply type :value-to-external
+ (widget-default-get type))))))
(t
(error "Unknown escape `%c'" escape)))))
(widget-put widget
:value-create 'widget-group-value-create
:value-delete 'widget-children-value-delete
:value-get 'widget-editable-list-value-get
+ :default-get 'widget-group-default-get
:validate 'widget-children-validate
:match 'widget-group-match
:match-inline 'widget-group-match-inline)
children))
(widget-put widget :children (nreverse children))))
+(defun widget-group-default-get (widget)
+ ;; Get the default of the components.
+ (mapcar 'widget-default-get (widget-get widget :args)))
+
(defun widget-group-match (widget values)
;; Match if the components match.
(and (listp values)
:format "%v\n%h"
:documentation-property 'variable-documentation)
+(define-widget 'other 'sexp
+ "Matches any value, but doesn't let the user edit the value.
+This is useful as last item in a `choice' widget.
+You should use this widget type with a default value,
+as in (other DEFAULT) or (other :tag \"NAME\" DEFAULT).
+If the user selects this alternative, that specifies DEFAULT
+as the value."
+ :tag "Other"
+ :format "%t%n"
+ :value 'other)
+
(defvar widget-string-prompt-value-history nil
"History of input to `widget-string-prompt-value'.")
(define-widget 'variable 'symbol
;; Should complete on variables.
- "A lisp variable."
+ "A Lisp variable."
:prompt-match 'boundp
:prompt-history 'widget-variable-prompt-value-history
:tag "Variable")
)
(define-widget 'sexp 'editable-field
- "An arbitrary lisp expression."
+ "An arbitrary Lisp expression."
:tag "Lisp expression"
:format "%{%t%}: %v"
:value nil
(integerp value))))
(define-widget 'list 'group
- "A lisp list."
+ "A Lisp list."
:tag "List"
:format "%{%t%}:\n%v")
(define-widget 'vector 'group
- "A lisp vector."
+ "A Lisp vector."
:tag "Vector"
:format "%{%t%}:\n%v"
:match 'widget-vector-match
HCoop / bpt / emacs.git / blobdiff