: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)))
:value-to-internal value)))
(defun widget-default-get (widget)
- "Extract the defaylt value of WIDGET."
+ "Extract the default value of WIDGET."
(or (widget-get widget :value)
(widget-apply widget :default-get)))
widget))
nil)))
-(defcustom widget-use-overlay-change (string-match "XEmacs" emacs-version)
+(defvar widget-use-overlay-change t
"If non-nil, use overlay change functions to tab around in the buffer.
-This is much faster, but doesn't work reliably on Emacs 19.34."
- :type 'boolean
- :group 'widgets)
+This is much faster, but doesn't work reliably on Emacs 19.34.")
(defun widget-move (arg)
"Move point to the ARG next field or button.
"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."
(to-field (widget-field-find to)))
(cond ((not (eq from-field to-field))
(add-hook 'post-command-hook 'widget-add-change nil t)
- (error "Change should be restricted to a single field"))
+ (signal 'text-read-only
+ '("Change should be restricted to a single field")))
((null from-field)
(add-hook 'post-command-hook 'widget-add-change nil t)
- (error "Attempt to change text outside editable field"))
+ (signal 'text-read-only
+ '("Attempt to change text outside editable field")))
(widget-field-use-before-change
(condition-case nil
(widget-apply from-field :notify from-field)
(explicit (widget-get widget :explicit-choice))
(explicit-value (widget-get widget :explicit-choice-value))
current)
- (if (and explicit (eq value explicit-value))
+ (if (and explicit (equal value explicit-value))
(progn
;; If the user specified the choice for this value,
;; respect that choice as long as the value is the same.
(setq child (widget-create-child-value
widget type value))
(setq child (widget-create-child-value
- widget type (widget-default-get type)))))
+ widget type
+ (widget-apply type :value-to-external
+ (widget-default-get type))))))
(t
(error "Unknown escape `%c'" escape)))))
(widget-put widget
(not (widget-get parent :documentation-shown))))
;; Redraw.
(widget-value-set widget (widget-value widget)))
-
+\f
;;; The Sexp Widgets.
(define-widget 'const 'item
:prompt-history 'widget-variable-prompt-value-history
:tag "Variable")
-(when (featurep 'mule)
- (defvar widget-coding-system-prompt-value-history nil
- "History of input to `widget-coding-system-prompt-value'.")
+(defvar widget-coding-system-prompt-value-history nil
+ "History of input to `widget-coding-system-prompt-value'.")
- (define-widget 'coding-system 'symbol
- "A MULE coding-system."
- :format "%{%t%}: %v"
- :tag "Coding system"
- :prompt-history 'widget-coding-system-prompt-value-history
- :prompt-value 'widget-coding-system-prompt-value
- :action 'widget-coding-system-action)
+(define-widget 'coding-system 'symbol
+ "A MULE coding-system."
+ :format "%{%t%}: %v"
+ :tag "Coding system"
+ :prompt-history 'widget-coding-system-prompt-value-history
+ :prompt-value 'widget-coding-system-prompt-value
+ :action 'widget-coding-system-action)
- (defun widget-coding-system-prompt-value (widget prompt value unbound)
- ;; Read coding-system from minibuffer.
- (intern
- (completing-read (format "%s (default %s) " prompt value)
- (mapcar (function
- (lambda (sym)
- (list (symbol-name sym))
- ))
- (coding-system-list)))))
-
- (defun widget-coding-system-action (widget &optional event)
- ;; Read a file name from the minibuffer.
- (let ((answer
- (widget-coding-system-prompt-value
- widget
- (widget-apply widget :menu-tag-get)
- (widget-value widget)
- t)))
- (widget-value-set widget answer)
- (widget-apply widget :notify widget event)
- (widget-setup)))
- )
-
+(defun widget-coding-system-prompt-value (widget prompt value unbound)
+ ;; Read coding-system from minibuffer.
+ (intern
+ (completing-read (format "%s (default %s) " prompt value)
+ (mapcar (function
+ (lambda (sym)
+ (list (symbol-name sym))
+ ))
+ (coding-system-list)))))
+
+(defun widget-coding-system-action (widget &optional event)
+ ;; Read a file name from the minibuffer.
+ (let ((answer
+ (widget-coding-system-prompt-value
+ widget
+ (widget-apply widget :menu-tag-get)
+ (widget-value widget)
+ t)))
+ (widget-value-set widget answer)
+ (widget-apply widget :notify widget event)
+ (widget-setup)))
+\f
(define-widget 'sexp 'editable-field
"An arbitrary Lisp expression."
:tag "Lisp expression"
(setq matched t))
(setq alternatives (cdr alternatives)))
matched))
-
+\f
(define-widget 'integer 'restricted-sexp
"An integer."
:tag "Integer"
(and (consp value)
(widget-group-match widget
(widget-apply widget :value-to-internal value))))
+\f
+;;; The `plist' Widget.
+;;
+;; Property lists.
+
+(define-widget 'plist 'list
+ "A property list."
+ :key-type '(symbol :tag "Key")
+ :value-type '(sexp :tag "Value")
+ :convert-widget 'widget-plist-convert-widget
+ :tag "Plist")
+
+(defvar widget-plist-value-type) ;Dynamic variable
+
+(defun widget-plist-convert-widget (widget)
+ ;; Handle `:options'.
+ (let* ((options (widget-get widget :options))
+ (key-type (widget-get widget :key-type))
+ (widget-plist-value-type (widget-get widget :value-type))
+ (other `(editable-list :inline t
+ (group :inline t
+ ,key-type
+ ,widget-plist-value-type)))
+ (args (if options
+ (list `(checklist :inline t
+ :greedy t
+ ,@(mapcar 'widget-plist-convert-option
+ options))
+ other)
+ (list other))))
+ (widget-put widget :args args)
+ widget))
+(defun widget-plist-convert-option (option)
+ ;; Convert a single plist option.
+ (let (key-type value-type)
+ (if (listp option)
+ (let ((key (nth 0 option)))
+ (setq value-type (nth 1 option))
+ (if (listp key)
+ (setq key-type key)
+ (setq key-type `(const ,key))))
+ (setq key-type `(const ,option)
+ value-type widget-plist-value-type))
+ `(group :format "Key: %v" :inline t ,key-type ,value-type)))
+
+
+;;; The `alist' Widget.
+;;
+;; Association lists.
+
+(define-widget 'alist 'list
+ "An association list."
+ :key-type '(sexp :tag "Key")
+ :value-type '(sexp :tag "Value")
+ :convert-widget 'widget-alist-convert-widget
+ :tag "Alist")
+
+(defvar widget-alist-value-type) ;Dynamic variable
+
+(defun widget-alist-convert-widget (widget)
+ ;; Handle `:options'.
+ (let* ((options (widget-get widget :options))
+ (key-type (widget-get widget :key-type))
+ (widget-alist-value-type (widget-get widget :value-type))
+ (other `(editable-list :inline t
+ (cons :format "%v"
+ ,key-type
+ ,widget-alist-value-type)))
+ (args (if options
+ (list `(checklist :inline t
+ :greedy t
+ ,@(mapcar 'widget-alist-convert-option
+ options))
+ other)
+ (list other))))
+ (widget-put widget :args args)
+ widget))
+
+(defun widget-alist-convert-option (option)
+ ;; Convert a single alist option.
+ (let (key-type value-type)
+ (if (listp option)
+ (let ((key (nth 0 option)))
+ (setq value-type (nth 1 option))
+ (if (listp key)
+ (setq key-type key)
+ (setq key-type `(const ,key))))
+ (setq key-type `(const ,option)
+ value-type widget-alist-value-type))
+ `(cons :format "Key: %v" ,key-type ,value-type)))
+\f
(define-widget 'choice 'menu-choice
"A union of several sexp types."
:tag "Choice"
(if current
(widget-prompt-value current prompt nil t)
value)))
-
+\f
(define-widget 'radio 'radio-button-choice
"A union of several sexp types."
:tag "Choice"
(defun widget-boolean-prompt-value (widget prompt value unbound)
;; Toggle a boolean.
(y-or-n-p prompt))
-
+\f
;;; The `color' Widget.
(define-widget 'color 'editable-field
(overlay-put (widget-get widget :sample-overlay)
'face (widget-apply widget :sample-face-get))
(widget-default-notify widget child event))
-
+\f
;;; The Help Echo
(defun widget-echo-help-mouse ()
HCoop / bpt / emacs.git / blobdiff