202 |
"Choose an item from a list. |
"Choose an item from a list. |
203 |
|
|
204 |
First argument TITLE is the name of the list. |
First argument TITLE is the name of the list. |
205 |
Second argument ITEMS is an list whose members are either |
Second argument ITEMS is a list whose members are either |
206 |
(NAME . VALUE), to indicate selectable items, or just strings to |
(NAME . VALUE), to indicate selectable items, or just strings to |
207 |
indicate unselectable items. |
indicate unselectable items. |
208 |
Optional third argument EVENT is an input event. |
Optional third argument EVENT is an input event. |
271 |
(while (not (or (and (>= char ?0) (< char next-digit)) |
(while (not (or (and (>= char ?0) (< char next-digit)) |
272 |
(eq value 'keyboard-quit))) |
(eq value 'keyboard-quit))) |
273 |
;; Unread a SPC to lead to our new menu. |
;; Unread a SPC to lead to our new menu. |
274 |
(setq unread-command-events (cons ?\ unread-command-events)) |
(setq unread-command-events (cons ?\ unread-command-events)) |
275 |
(setq keys (read-key-sequence title)) |
(setq keys (read-key-sequence title)) |
276 |
(setq value |
(setq value |
277 |
(lookup-key overriding-terminal-local-map keys t) |
(lookup-key overriding-terminal-local-map keys t) |
301 |
(nreverse result))) |
(nreverse result))) |
302 |
|
|
303 |
;;; Widget text specifications. |
;;; Widget text specifications. |
304 |
;; |
;; |
305 |
;; These functions are for specifying text properties. |
;; These functions are for specifying text properties. |
306 |
|
|
307 |
(defvar widget-field-add-space t |
(defvar widget-field-add-space t |
333 |
(rear-sticky |
(rear-sticky |
334 |
(or (not widget-field-add-space) (widget-get widget :size)))) |
(or (not widget-field-add-space) (widget-get widget :size)))) |
335 |
(if (functionp help-echo) |
(if (functionp help-echo) |
336 |
(setq help-echo 'widget-mouse-help)) |
(setq help-echo 'widget-mouse-help)) |
337 |
(when (= (char-before to) ?\n) |
(when (= (char-before to) ?\n) |
338 |
;; When the last character in the field is a newline, we want to |
;; When the last character in the field is a newline, we want to |
339 |
;; give it a `field' char-property of `boundary', which helps the |
;; give it a `field' char-property of `boundary', which helps the |
508 |
:value-to-internal value))) |
:value-to-internal value))) |
509 |
|
|
510 |
(defun widget-default-get (widget) |
(defun widget-default-get (widget) |
511 |
"Extract the default value of WIDGET." |
"Extract the default external value of WIDGET." |
512 |
(or (widget-get widget :value) |
(widget-apply widget :value-to-external |
513 |
(widget-apply widget :default-get))) |
(or (widget-get widget :value) |
514 |
|
(widget-apply widget :default-get)))) |
515 |
|
|
516 |
(defun widget-match-inline (widget vals) |
(defun widget-match-inline (widget vals) |
517 |
"In WIDGET, match the start of VALS." |
"In WIDGET, match the start of VALS." |
689 |
|
|
690 |
(defun widget-create-child (parent type) |
(defun widget-create-child (parent type) |
691 |
"Create widget of TYPE." |
"Create widget of TYPE." |
692 |
(let ((widget (copy-sequence type))) |
(let ((widget (widget-copy type))) |
693 |
(widget-put widget :parent parent) |
(widget-put widget :parent parent) |
694 |
(unless (widget-get widget :indent) |
(unless (widget-get widget :indent) |
695 |
(widget-put widget :indent (+ (or (widget-get parent :indent) 0) |
(widget-put widget :indent (+ (or (widget-get parent :indent) 0) |
700 |
|
|
701 |
(defun widget-create-child-value (parent type value) |
(defun widget-create-child-value (parent type value) |
702 |
"Create widget of TYPE with value VALUE." |
"Create widget of TYPE with value VALUE." |
703 |
(let ((widget (copy-sequence type))) |
(let ((widget (widget-copy type))) |
704 |
(widget-put widget :value (widget-apply widget :value-to-internal value)) |
(widget-put widget :value (widget-apply widget :value-to-internal value)) |
705 |
(widget-put widget :parent parent) |
(widget-put widget :parent parent) |
706 |
(unless (widget-get widget :indent) |
(unless (widget-get widget :indent) |
715 |
"Delete WIDGET." |
"Delete WIDGET." |
716 |
(widget-apply widget :delete)) |
(widget-apply widget :delete)) |
717 |
|
|
718 |
|
(defun widget-copy (widget) |
719 |
|
"Make a deep copy of WIDGET." |
720 |
|
(widget-apply (copy-sequence widget) :copy)) |
721 |
|
|
722 |
(defun widget-convert (type &rest args) |
(defun widget-convert (type &rest args) |
723 |
"Convert TYPE to a widget without inserting it in the buffer. |
"Convert TYPE to a widget without inserting it in the buffer. |
724 |
The optional ARGS are additional keyword arguments." |
The optional ARGS are additional keyword arguments." |
727 |
(list type) |
(list type) |
728 |
(copy-sequence type))) |
(copy-sequence type))) |
729 |
(current widget) |
(current widget) |
730 |
|
done |
731 |
(keys args)) |
(keys args)) |
732 |
;; First set the :args keyword. |
;; First set the :args keyword. |
733 |
(while (cdr current) ;Look in the type. |
(while (cdr current) ;Look in the type. |
734 |
(if (keywordp (car (cdr current))) |
(if (and (keywordp (cadr current)) |
735 |
(setq current (cdr (cdr current))) |
;; If the last element is a keyword, |
736 |
|
;; it is still the :args element, |
737 |
|
;; even though it is a keyword. |
738 |
|
(cddr current)) |
739 |
|
(if (eq (cadr current) :args) |
740 |
|
;; If :args is explicitly specified, obey it. |
741 |
|
(setq current nil) |
742 |
|
;; Some other irrelevant keyword. |
743 |
|
(setq current (cdr (cdr current)))) |
744 |
(setcdr current (list :args (cdr current))) |
(setcdr current (list :args (cdr current))) |
745 |
(setq current nil))) |
(setq current nil))) |
746 |
(while args ;Look in the args. |
(while (and args (not done)) ;Look in ARGS. |
747 |
(if (keywordp (nth 0 args)) |
(cond ((eq (car args) :args) |
748 |
(setq args (nthcdr 2 args)) |
;; Handle explicit specification of :args. |
749 |
(widget-put widget :args args) |
(setq args (cadr args) |
750 |
(setq args nil))) |
done t)) |
751 |
|
((keywordp (car args)) |
752 |
|
(setq args (cddr args))) |
753 |
|
(t (setq done t)))) |
754 |
|
(when done |
755 |
|
(widget-put widget :args args)) |
756 |
;; Then Convert the widget. |
;; Then Convert the widget. |
757 |
(setq type widget) |
(setq type widget) |
758 |
(while type |
(while type |
892 |
(if (widget-event-point event) |
(if (widget-event-point event) |
893 |
(let* ((pos (widget-event-point event)) |
(let* ((pos (widget-event-point event)) |
894 |
(start (event-start event)) |
(start (event-start event)) |
895 |
(button (get-char-property |
(button (get-char-property |
896 |
pos 'button (and (windowp (posn-window start)) |
pos 'button (and (windowp (posn-window start)) |
897 |
(window-buffer (posn-window start)))))) |
(window-buffer (posn-window start)))))) |
898 |
(if button |
(if button |
1002 |
"Move point to the ARG next field or button. |
"Move point to the ARG next field or button. |
1003 |
ARG may be negative to move backward." |
ARG may be negative to move backward." |
1004 |
(or (bobp) (> arg 0) (backward-char)) |
(or (bobp) (> arg 0) (backward-char)) |
1005 |
(let ((pos (point)) |
(let ((wrapped 0) |
1006 |
(number arg) |
(number arg) |
1007 |
(old (widget-tabable-at)) |
(old (widget-tabable-at)) |
1008 |
new) |
new) |
1009 |
;; Forward. |
;; Forward. |
1010 |
(while (> arg 0) |
(while (> arg 0) |
1011 |
(cond ((eobp) |
(cond ((eobp) |
1012 |
(goto-char (point-min))) |
(goto-char (point-min)) |
1013 |
|
(setq wrapped (1+ wrapped))) |
1014 |
(widget-use-overlay-change |
(widget-use-overlay-change |
1015 |
(goto-char (next-overlay-change (point)))) |
(goto-char (next-overlay-change (point)))) |
1016 |
(t |
(t |
1017 |
(forward-char 1))) |
(forward-char 1))) |
1018 |
(and (eq pos (point)) |
(and (= wrapped 2) |
1019 |
(eq arg number) |
(eq arg number) |
1020 |
(error "No buttons or fields found")) |
(error "No buttons or fields found")) |
1021 |
(let ((new (widget-tabable-at))) |
(let ((new (widget-tabable-at))) |
1026 |
;; Backward. |
;; Backward. |
1027 |
(while (< arg 0) |
(while (< arg 0) |
1028 |
(cond ((bobp) |
(cond ((bobp) |
1029 |
(goto-char (point-max))) |
(goto-char (point-max)) |
1030 |
|
(setq wrapped (1+ wrapped))) |
1031 |
(widget-use-overlay-change |
(widget-use-overlay-change |
1032 |
(goto-char (previous-overlay-change (point)))) |
(goto-char (previous-overlay-change (point)))) |
1033 |
(t |
(t |
1034 |
(backward-char 1))) |
(backward-char 1))) |
1035 |
(and (eq pos (point)) |
(and (= wrapped 2) |
1036 |
(eq arg number) |
(eq arg number) |
1037 |
(error "No buttons or fields found")) |
(error "No buttons or fields found")) |
1038 |
(let ((new (widget-tabable-at))) |
(let ((new (widget-tabable-at))) |
1278 |
found (widget-apply child :validate))) |
found (widget-apply child :validate))) |
1279 |
found)) |
found)) |
1280 |
|
|
1281 |
|
(defun widget-types-copy (widget) |
1282 |
|
"Copy :args as widget types in WIDGET." |
1283 |
|
(widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) |
1284 |
|
widget) |
1285 |
|
|
1286 |
;; Made defsubst to speed up face editor creation. |
;; Made defsubst to speed up face editor creation. |
1287 |
(defsubst widget-types-convert-widget (widget) |
(defsubst widget-types-convert-widget (widget) |
1288 |
"Convert :args as widget types in WIDGET." |
"Convert :args as widget types in WIDGET." |
1317 |
:indent nil |
:indent nil |
1318 |
:offset 0 |
:offset 0 |
1319 |
:format-handler 'widget-default-format-handler |
:format-handler 'widget-default-format-handler |
1320 |
:button-face-get 'widget-default-button-face-get |
:button-face-get 'widget-default-button-face-get |
1321 |
:sample-face-get 'widget-default-sample-face-get |
:sample-face-get 'widget-default-sample-face-get |
1322 |
:delete 'widget-default-delete |
:delete 'widget-default-delete |
1323 |
|
:copy 'identity |
1324 |
:value-set 'widget-default-value-set |
:value-set 'widget-default-value-set |
1325 |
:value-inline 'widget-default-value-inline |
:value-inline 'widget-default-value-inline |
1326 |
:default-get 'widget-default-default-get |
:default-get 'widget-default-default-get |
1534 |
(or (widget-get widget :always-active) |
(or (widget-get widget :always-active) |
1535 |
(and (not (widget-get widget :inactive)) |
(and (not (widget-get widget :inactive)) |
1536 |
(let ((parent (widget-get widget :parent))) |
(let ((parent (widget-get widget :parent))) |
1537 |
(or (null parent) |
(or (null parent) |
1538 |
(widget-apply parent :active)))))) |
(widget-apply parent :active)))))) |
1539 |
|
|
1540 |
(defun widget-default-deactivate (widget) |
(defun widget-default-deactivate (widget) |
1728 |
(find-file (locate-library (widget-value widget)))) |
(find-file (locate-library (widget-value widget)))) |
1729 |
|
|
1730 |
;;; The `emacs-commentary-link' Widget. |
;;; The `emacs-commentary-link' Widget. |
1731 |
|
|
1732 |
(define-widget 'emacs-commentary-link 'link |
(define-widget 'emacs-commentary-link 'link |
1733 |
"A link to Commentary in an Emacs Lisp library file." |
"A link to Commentary in an Emacs Lisp library file." |
1734 |
:action 'widget-emacs-commentary-link-action) |
:action 'widget-emacs-commentary-link-action) |
1735 |
|
|
1736 |
(defun widget-emacs-commentary-link-action (widget &optional event) |
(defun widget-emacs-commentary-link-action (widget &optional event) |
1737 |
"Find the Commentary section of the Emacs file specified by WIDGET." |
"Find the Commentary section of the Emacs file specified by WIDGET." |
1738 |
(finder-commentary (widget-value widget))) |
(finder-commentary (widget-value widget))) |
1866 |
(define-widget 'menu-choice 'default |
(define-widget 'menu-choice 'default |
1867 |
"A menu of options." |
"A menu of options." |
1868 |
:convert-widget 'widget-types-convert-widget |
:convert-widget 'widget-types-convert-widget |
1869 |
|
:copy 'widget-types-copy |
1870 |
:format "%[%t%]: %v" |
:format "%[%t%]: %v" |
1871 |
:case-fold t |
:case-fold t |
1872 |
:tag "choice" |
:tag "choice" |
1996 |
(when this-explicit |
(when this-explicit |
1997 |
(widget-put widget :explicit-choice current) |
(widget-put widget :explicit-choice current) |
1998 |
(widget-put widget :explicit-choice-value (widget-get widget :value))) |
(widget-put widget :explicit-choice-value (widget-get widget :value))) |
1999 |
(widget-value-set |
(widget-value-set widget (widget-default-get current)) |
|
widget (widget-apply current |
|
|
:value-to-external (widget-default-get current))) |
|
2000 |
(widget-setup) |
(widget-setup) |
2001 |
(widget-apply widget :notify widget event))) |
(widget-apply widget :notify widget event))) |
2002 |
(run-hook-with-args 'widget-edit-functions widget)) |
(run-hook-with-args 'widget-edit-functions widget)) |
2103 |
(define-widget 'checklist 'default |
(define-widget 'checklist 'default |
2104 |
"A multiple choice widget." |
"A multiple choice widget." |
2105 |
:convert-widget 'widget-types-convert-widget |
:convert-widget 'widget-types-convert-widget |
2106 |
|
:copy 'widget-types-copy |
2107 |
:format "%v" |
:format "%v" |
2108 |
:offset 4 |
:offset 4 |
2109 |
:entry-format "%b %v" |
:entry-format "%b %v" |
2281 |
(define-widget 'radio-button-choice 'default |
(define-widget 'radio-button-choice 'default |
2282 |
"Select one of multiple options." |
"Select one of multiple options." |
2283 |
:convert-widget 'widget-types-convert-widget |
:convert-widget 'widget-types-convert-widget |
2284 |
|
:copy 'widget-types-copy |
2285 |
:offset 4 |
:offset 4 |
2286 |
:format "%v" |
:format "%v" |
2287 |
:entry-format "%b %v" |
:entry-format "%b %v" |
2470 |
(define-widget 'editable-list 'default |
(define-widget 'editable-list 'default |
2471 |
"A variable list of widgets of the same type." |
"A variable list of widgets of the same type." |
2472 |
:convert-widget 'widget-types-convert-widget |
:convert-widget 'widget-types-convert-widget |
2473 |
|
:copy 'widget-types-copy |
2474 |
:offset 12 |
:offset 12 |
2475 |
:format "%v%i\n" |
:format "%v%i\n" |
2476 |
:format-handler 'widget-editable-list-format-handler |
:format-handler 'widget-editable-list-format-handler |
2622 |
(setq child (widget-create-child-value |
(setq child (widget-create-child-value |
2623 |
widget type value)) |
widget type value)) |
2624 |
(setq child (widget-create-child-value |
(setq child (widget-create-child-value |
2625 |
widget type |
widget type (widget-default-get type))))) |
|
(widget-apply type :value-to-external |
|
|
(widget-default-get type)))))) |
|
2626 |
(t |
(t |
2627 |
(error "Unknown escape `%c'" escape))))) |
(error "Unknown escape `%c'" escape))))) |
2628 |
(widget-put widget |
(widget-put widget |
2644 |
(define-widget 'group 'default |
(define-widget 'group 'default |
2645 |
"A widget which groups other widgets inside." |
"A widget which groups other widgets inside." |
2646 |
:convert-widget 'widget-types-convert-widget |
:convert-widget 'widget-types-convert-widget |
2647 |
|
:copy 'widget-types-copy |
2648 |
:format "%v" |
:format "%v" |
2649 |
:value-create 'widget-group-value-create |
:value-create 'widget-group-value-create |
2650 |
:value-delete 'widget-children-value-delete |
:value-delete 'widget-children-value-delete |
2832 |
(widget-create-child-and-convert |
(widget-create-child-and-convert |
2833 |
widget 'visibility |
widget 'visibility |
2834 |
:help-echo "Show or hide rest of the documentation." |
:help-echo "Show or hide rest of the documentation." |
2835 |
|
:on "Hide Rest" |
2836 |
:off "More" |
:off "More" |
2837 |
:always-active t |
:always-active t |
2838 |
:action 'widget-parent-action |
:action 'widget-parent-action |
3059 |
|
|
3060 |
(defvar widget-coding-system-prompt-value-history nil |
(defvar widget-coding-system-prompt-value-history nil |
3061 |
"History of input to `widget-coding-system-prompt-value'.") |
"History of input to `widget-coding-system-prompt-value'.") |
3062 |
|
|
3063 |
(define-widget 'coding-system 'symbol |
(define-widget 'coding-system 'symbol |
3064 |
"A MULE coding-system." |
"A MULE coding-system." |
3065 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
3195 |
:match-alternatives '(integerp)) |
:match-alternatives '(integerp)) |
3196 |
|
|
3197 |
(define-widget 'number 'restricted-sexp |
(define-widget 'number 'restricted-sexp |
3198 |
"A floating point number." |
"A number (floating point or integer)." |
3199 |
:tag "Number" |
:tag "Number" |
3200 |
:value 0.0 |
:value 0.0 |
3201 |
:type-error "This field should contain a number" |
:type-error "This field should contain a number (floating point or integer)" |
3202 |
:match-alternatives '(numberp)) |
:match-alternatives '(numberp)) |
3203 |
|
|
3204 |
|
(define-widget 'float 'restricted-sexp |
3205 |
|
"A floating point number." |
3206 |
|
:tag "Floating point number" |
3207 |
|
:value 0.0 |
3208 |
|
:type-error "This field should contain a floating point number" |
3209 |
|
:match-alternatives '(floatp)) |
3210 |
|
|
3211 |
(define-widget 'character 'editable-field |
(define-widget 'character 'editable-field |
3212 |
"A character." |
"A character." |
3213 |
:tag "Character" |
:tag "Character" |
3431 |
|
|
3432 |
;;; The `color' Widget. |
;;; The `color' Widget. |
3433 |
|
|
3434 |
;; Fixme: match |
;; Fixme: match |
3435 |
(define-widget 'color 'editable-field |
(define-widget 'color 'editable-field |
3436 |
"Choose a color name (with sample)." |
"Choose a color name (with sample)." |
3437 |
:format "%t: %v (%{sample%})\n" |
:format "%t: %v (%{sample%})\n" |