;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 0.98
+;; Version: 0.997
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(require 'custom)
(error nil))
-(eval-and-compile
- (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args) nil)
- (defmacro defcustom (&rest args) nil)
- (defmacro defface (&rest args) nil)
- (when (fboundp 'copy-face)
- (copy-face 'default 'widget-documentation-face)
- (copy-face 'bold 'widget-button-face)
- (copy-face 'italic 'widget-field-face))
- (defvar widget-mouse-face 'highlight)
- (defvar widget-menu-max-size 40)))
+(unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args) nil)
+ (defmacro defcustom (&rest args) nil)
+ (defmacro defface (&rest args) nil)
+ (when (fboundp 'copy-face)
+ (copy-face 'default 'widget-documentation-face)
+ (copy-face 'bold 'widget-button-face)
+ (copy-face 'italic 'widget-field-face))
+ (defvar widget-mouse-face 'highlight)
+ (defvar widget-menu-max-size 40))
;;; Compatibility.
(add-text-properties (1- from) from (list 'rear-nonsticky t
'end-open t
'invisible t))
- (when (or (string-match ".%v" (widget-get widget :format))
+ (when (or (string-match "\\(.\\|\n\\)%v" (widget-get widget :format))
(widget-get widget :hide-front-space))
;; WARNING: This is going to lose horrible if the character just
;; before the field can be modified (e.g. if it belongs to a
(when (widget-get widget :size)
(put-text-property to (1+ to) 'invisible t)
- (when (or (string-match "%v." (widget-get widget :format))
+ (when (or (string-match "%v\\(.\\|\n\\)" (widget-get widget :format))
(widget-get widget :hide-rear-space))
;; WARNING: This is going to lose horrible if the character just
;; after the field can be modified (e.g. if it belongs to a
(let ((face (widget-apply widget :button-face-get)))
(add-text-properties from to (list 'button widget
'mouse-face widget-mouse-face
+ 'start-open t
+ 'end-open t
'face face))))
(defun widget-specify-doc (widget from to)
(define-key widget-keymap "\t" 'widget-forward)
(define-key widget-keymap "\M-\t" 'widget-backward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
+ (define-key widget-keymap [(shift tab)] 'widget-backward)
+ (define-key widget-keymap [backtab] 'widget-backward)
(if (string-match "XEmacs" (emacs-version))
(define-key widget-keymap [button2] 'widget-button-click)
(define-key widget-keymap [menu-bar] 'nil)
(widget-apply field :notify field))))
(error (debug))))
+;;; Widget Functions
+;;
+;; These functions are used in the definition of multiple widgets.
+
+(defun widget-children-value-delete (widget)
+ "Delete all :children and :buttons in WIDGET."
+ (mapcar 'widget-delete (widget-get widget :children))
+ (widget-put widget :children nil)
+ (mapcar 'widget-delete (widget-get widget :buttons))
+ (widget-put widget :buttons nil))
+
+(defun widget-types-convert-widget (widget)
+ "Convert :args as widget types in WIDGET."
+ (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
+ widget)
+
;;; The `default' Widget.
(define-widget 'default nil
:match 'widget-item-match
:match-inline 'widget-item-match-inline
:action 'widget-item-action
- :format "%t")
+ :format "%t\n")
(defun widget-item-convert-widget (widget)
;; Initialize :value and :tag from :args in WIDGET.
:value-to-internal
(widget-value widget))
'widget-field-history)))
+ (widget-apply widget :notify widget event)
(widget-setup)))
(defun widget-field-value-create (widget)
(setq from (1+ from)
to (1- to))
(while (and size
+ (not (zerop size))
(> to from)
(eq (char-after (1- to)) ?\ ))
(setq to (1- to)))
(define-widget 'menu-choice 'default
"A menu of options."
- :convert-widget 'widget-choice-convert-widget
+ :convert-widget 'widget-types-convert-widget
:format "%[%t%]: %v"
+ :case-fold t
:tag "choice"
:void '(item :format "invalid (%t)\n")
:value-create 'widget-choice-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-choice-value-get
:value-inline 'widget-choice-value-inline
:action 'widget-choice-action
:match 'widget-choice-match
:match-inline 'widget-choice-match-inline)
-(defun widget-choice-convert-widget (widget)
- ;; Expand type args into widget objects.
-; (widget-put widget :args (mapcar (lambda (child)
-; (if (widget-get child ':converted)
-; child
-; (widget-put child ':converted t)
-; (widget-convert child)))
-; (widget-get widget :args)))
- (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
- widget)
-
(defun widget-choice-value-create (widget)
;; Insert the first choice that matches the value.
(let ((value (widget-get widget :value))
(let ((args (widget-get widget :args))
(old (widget-get widget :choice))
(tag (widget-apply widget :menu-tag-get))
+ (completion-ignore-case (widget-get widget :case-fold))
current choices)
;; Remember old value.
(if (and old (not (widget-apply widget :validate)))
(widget-value-set widget
(widget-apply current :value-to-external
(widget-get current :value)))
- (widget-setup)))
+ (widget-apply widget :notify widget event)
+ (widget-setup)))
;; Notify parent.
(widget-apply widget :notify widget event)
(widget-clear-undo))
(define-widget 'checklist 'default
"A multiple choice widget."
- :convert-widget 'widget-choice-convert-widget
+ :convert-widget 'widget-types-convert-widget
:format "%v"
:offset 4
:entry-format "%b %v"
:menu-tag "checklist"
:greedy nil
:value-create 'widget-checklist-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-checklist-value-get
:validate 'widget-checklist-validate
:match 'widget-checklist-match
(define-widget 'radio-button-choice 'default
"Select one of multiple options."
- :convert-widget 'widget-choice-convert-widget
+ :convert-widget 'widget-types-convert-widget
:offset 4
:format "%v"
:entry-format "%b %v"
:menu-tag "radio"
:value-create 'widget-radio-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-radio-value-get
:value-inline 'widget-radio-value-inline
:value-set 'widget-radio-value-set
(widget-put widget :children (nconc children (list child))))
child)))
-(defun widget-radio-value-delete (widget)
- ;; Delete the child widgets.
- (mapcar 'widget-delete (widget-get widget :children))
- (widget-put widget :children nil)
- (mapcar 'widget-delete (widget-get widget :buttons))
- (widget-put widget :buttons nil))
-
(defun widget-radio-value-get (widget)
;; Get value of the child widget.
(let ((chosen (widget-radio-chosen widget)))
(define-widget 'editable-list 'default
"A variable list of widgets of the same type."
- :convert-widget 'widget-choice-convert-widget
+ :convert-widget 'widget-types-convert-widget
:offset 12
:format "%v%i\n"
:format-handler 'widget-editable-list-format-handler
:entry-format "%i %d %v"
:menu-tag "editable-list"
:value-create 'widget-editable-list-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-editable-list-value-get
:validate 'widget-editable-list-validate
:match 'widget-editable-list-match
(define-widget 'group 'default
"A widget which group other widgets inside."
- :convert-widget 'widget-choice-convert-widget
+ :convert-widget 'widget-types-convert-widget
:format "%v"
:value-create 'widget-group-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-editable-list-value-get
:validate 'widget-editable-list-validate
:match 'widget-group-match
(condition-case nil
(documentation symbol t)
(error nil)))
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:match (lambda (widget value) (symbolp value)))
(define-widget 'variable-item 'item
"An immutable variable name."
:format "%v\n%h"
:documentation-property 'variable-documentation
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:match (lambda (widget value) (symbolp value)))
(define-widget 'string 'editable-field
:format "%[%t%]: %v")
(define-widget 'regexp 'string
+ "A regular expression."
;; Should do validation.
- "A regular expression.")
+ :tag "Regexp")
(define-widget 'file 'string
"A file widget.
(answer (read-file-name (concat menu-tag ": (defalt `" value "') ")
dir nil must-match file)))
(widget-value-set widget (abbreviate-file-name answer))
+ (widget-apply widget :notify widget event)
(widget-setup)))
(define-widget 'directory 'file
(intern value)
value)))
-(define-widget 'function 'symbol
+(define-widget 'function 'sexp
;; Should complete on functions.
"A lisp function."
:tag "Function")
value))
:match (lambda (widget value) (integerp value)))
+(define-widget 'character 'string
+ "An character."
+ :tag "Character"
+ :value 0
+ :size 1
+ :format "%t: %v\n"
+ :type-error "This field should contain a character"
+ :value-to-internal (lambda (widget value)
+ (if (integerp value)
+ (char-to-string value)
+ value))
+ :value-to-external (lambda (widget value)
+ (if (stringp value)
+ (aref value 0)
+ value))
+ :match (lambda (widget value) (integerp value)))
+
(define-widget 'number 'sexp
"A floating point number."
:tag "Number"
value))
:match (lambda (widget value) (numberp value)))
-(define-widget 'hook 'sexp
- "A emacs lisp hook"
- :tag "Hook")
-
(define-widget 'list 'group
"A lisp list."
:tag "List"
:tag "Color"
:value "default"
:value-create 'widget-color-value-create
- :value-delete 'widget-radio-value-delete
+ :value-delete 'widget-children-value-delete
:value-get 'widget-color-value-get
:value-set 'widget-color-value-set
:action 'widget-color-action
(t
(read-string prompt (widget-value widget))))))
(unless (zerop (length answer))
- (widget-value-set widget answer))))
+ (widget-value-set widget answer)
+ (widget-apply widget :notify widget event)
+ (widget-setup))))
;;; The Help Echo
(defun widget-echo-help-mouse ()
"Display the help message for the widget under the mouse.
-Enable with (run-with-idle-timer 2 t 'widget-echo-help-mouse)"
+Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)"
(let* ((pos (mouse-position))
(frame (car pos))
(x (car (cdr pos)))
projects / gnus / blobdiff