Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
8697863a
Commit
8697863a
authored
Jun 15, 1997
by
Per Abrahamsen
Browse files
Synched with 1.9920.
parent
9432de85
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
233 additions
and
73 deletions
+233
-73
lisp/cus-edit.el
lisp/cus-edit.el
+38
-23
lisp/wid-edit.el
lisp/wid-edit.el
+192
-48
lisp/widget.el
lisp/widget.el
+3
-2
No files found.
lisp/cus-edit.el
View file @
8697863a
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.99
14
;; Version: 1.99
20
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -1206,6 +1206,8 @@ and `face'."
(or (not hidden)
(memq category custom-magic-show-hidden)))
(insert "
")
(when (eq category 'group)
(insert-char ?\ (1+ (* 2 (widget-get parent :custom-level)))))
(push (widget-create-child-and-convert
widget 'choice-item
:help-echo "
Change
the
state
of
this
item.
"
...
...
@@ -1277,7 +1279,8 @@ and `face'."
;; We recognize extra escape sequences.
(let* ((buttons (widget-get widget :buttons))
(state (widget-get widget :custom-state))
(level (widget-get widget :custom-level)))
(level (widget-get widget :custom-level))
(category (widget-get widget :custom-category)))
(cond ((eq escape ?l)
(when level
(insert-char ?\ (1- level))
...
...
@@ -1298,9 +1301,12 @@ and `face'."
(when (and level (not (eq state 'hidden)))
(insert-char ?- (- 76 (current-column) level))
(insert "
\\
")))
((eq escape ?i)
(insert-char ?\ (+ 1 level level)))
((eq escape ?L)
(push (widget-create-child-and-convert
widget 'visibility
:help-echo "
Show
or
hide
this
group.
"
:action 'custom-toggle-parent
(not (eq state 'hidden)))
buttons))
...
...
@@ -1322,6 +1328,8 @@ and `face'."
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
(when (eq category 'group)
(insert-char ?\ (1+ (* 2 level))))
(insert "
See
also
")
(while links
(push (widget-create-child-and-convert widget (car links))
...
...
@@ -1430,7 +1438,8 @@ and `face'."
(t
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)))
(custom-redraw widget)))
(custom-redraw widget)
(widget-setup)))
(defun custom-toggle-parent (widget &rest ignore)
"
Toggle
visibility
of
parent
to
WIDGET.
"
...
...
@@ -1517,6 +1526,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
buttons)
(push (widget-create-child-and-convert
widget 'visibility
:help-echo "
Show
the
value
of
this
option.
"
:action 'custom-toggle-parent
nil)
buttons))
...
...
@@ -1533,6 +1543,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(insert (symbol-name symbol) "
:
")
(push (widget-create-child-and-convert
widget 'visibility
:help-echo "
Hide
the
value
of
this
option.
"
:action 'custom-toggle-parent
t)
buttons)
...
...
@@ -1557,6 +1568,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
widget 'item
:format tag-format
:action 'custom-tag-action
:help-echo "
Change
value
of
this
option.
"
:mouse-down-action 'custom-tag-mouse-down-action
:button-face 'custom-variable-button-face
:sample-face 'custom-variable-sample-face
...
...
@@ -1565,6 +1577,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(insert "
")
(push (widget-create-child-and-convert
widget 'visibility
:help-echo "
Hide
the
value
of
this
option.
"
:action 'custom-toggle-parent
t)
buttons)
...
...
@@ -1623,13 +1636,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(widget-put widget :custom-state state)))
(defvar custom-variable-menu
'(("
Edit
" custom-variable-edit
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'edit))))
("
Edit
Lisp
" custom-variable-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp))))
("
Set
" custom-variable-set
'(("
Set
" custom-variable-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
("
Save
" custom-variable-save
...
...
@@ -1648,7 +1655,14 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(lambda (widget)
(and (get (widget-value widget) 'standard-value)
(memq (widget-get widget :custom-state)
'(modified set changed saved rogue))))))
'(modified set changed saved rogue)))))
("
---
" ignore ignore)
("
Don
't
show
as
Lisp
expression
" custom-variable-edit
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'edit))))
("
Show
as
Lisp
expression
" custom-variable-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp)))))
"
Alist
of
actions
for
the
`
custom-variable
'
widget.
Each
entry
has
the
form
(
NAME
ACTION
FILTER
)
where
NAME
is
the
name
of
the
menu
entry,
ACTION
is
the
function
to
call
on
the
widget
when
the
...
...
@@ -1958,23 +1972,24 @@ Match frames with dark backgrounds.")
(message "
Creating
face
editor...done
")))
(defvar custom-face-menu
'(("
Edit
Selected
" custom-face-edit-selected
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'selected))))
("
Edit
All
" custom-face-edit-all
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'all))))
("
Edit
Lisp
" custom-face-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp))))
("
Set
" custom-face-set)
'(("
Set
" custom-face-set)
("
Save
" custom-face-save)
("
Reset
to
Saved
" custom-face-reset-saved
(lambda (widget)
(get (widget-value widget) 'saved-face)))
("
Reset
to
Standard
Setting
" custom-face-reset-standard
(lambda (widget)
(get (widget-value widget) 'face-defface-spec))))
(get (widget-value widget) 'face-defface-spec)))
("
---
" ignore ignore)
("
Show
all
display
specs
" custom-face-edit-all
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'all))))
("
Just
current
attributes
" custom-face-edit-selected
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'selected))))
("
Show
as
Lisp
expression
" custom-face-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp)))))
"
Alist
of
actions
for
the
`
custom-face
'
widget.
Each
entry
has
the
form
(
NAME
ACTION
FILTER
)
where
NAME
is
the
name
of
the
menu
entry,
ACTION
is
the
function
to
call
on
the
widget
when
the
...
...
@@ -2181,7 +2196,7 @@ and so forth. The remaining group tags are shown with
(define-widget 'custom-group 'custom
"
Customize
group.
"
:format "
%l
%{%t%}
group:
%L
%-\n%m%h%a%v%e
"
:format "
%l
%{%t%}
group:
%L
%-\n%m%
i%
h%a%v%e
"
:sample-face-get 'custom-group-sample-face-get
:documentation-property 'group-documentation
:help-echo "
Set
or
reset
all
members
of
this
group.
"
...
...
lisp/wid-edit.el
View file @
8697863a
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.99
14
;; Version: 1.99
20
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -125,11 +125,26 @@ is the string or buffer containing the text."
:group
'extensions
:group
'hypermedia
)
(
defgroup
widget-documentation
nil
"Options controling the display of documentation strings."
:group
'widgets
)
(
defgroup
widget-faces
nil
"Faces used by the widget library."
:group
'widgets
:group
'faces
)
(
defface
widget-documentation-face
'
((((
class
color
)
(
background
dark
))
(
:foreground
"lime green"
))
(((
class
color
)
(
background
light
))
(
:foreground
"dark green"
))
(
t
nil
))
"Face used for documentation text."
:group
'widget-documentation
:group
'widget-faces
)
(
defface
widget-button-face
'
((
t
(
:bold
t
)))
"Face used for widget buttons."
:group
'widget-faces
)
...
...
@@ -257,6 +272,19 @@ minibuffer."
'start-open
nil
'end-open
nil
)))
(
defcustom
widget-field-add-space
(
or
(
<
emacs-major-version
20
)
(
and
(
eq
emacs-major-version
20
)
(
<
emacs-minor-version
3
))
(
not
(
string-match
"XEmacs"
emacs-version
)))
"Non-nil means add extra space at the end of editable text fields.
This is needed on all versions of Emacs, and on XEmacs before 20.3.
If you don't add the space, it will become impossible to edit a zero
size field."
:type
'boolean
:group
'widgets
)
(
defun
widget-specify-field
(
widget
from
to
)
"Specify editable button for WIDGET between FROM and TO."
(
put-text-property
from
to
'read-only
nil
)
...
...
@@ -265,7 +293,8 @@ minibuffer."
;; at the end of the overlay.
(
save-excursion
(
goto-char
to
)
(
insert-and-inherit
" "
)
(
when
widget-field-add-space
(
insert-and-inherit
" "
))
(
setq
to
(
point
)))
(
add-text-properties
(
1-
to
)
to
;to (1+ to)
'
(
front-sticky
nil
start-open
t
read-only
to
))
...
...
@@ -319,7 +348,6 @@ minibuffer."
(
add-text-properties
from
to
(
list
'start-open
t
'end-open
t
'face
face
)))))
(
defun
widget-specify-doc
(
widget
from
to
)
;; Specify documentation for WIDGET between FROM and TO.
(
add-text-properties
from
to
(
list
'widget-doc
widget
...
...
@@ -443,10 +471,9 @@ ARGS are passed as extra arguments to the function."
(
defun
widget-apply-action
(
widget
&optional
event
)
"Apply :action in WIDGET in response to EVENT."
(
let
(
after-change-functions
)
(
if
(
widget-apply
widget
:active
)
(
widget-apply
widget
:action
event
)
(
error
"Attempt to perform action on inactive widget"
))))
(
if
(
widget-apply
widget
:active
)
(
widget-apply
widget
:action
event
)
(
error
"Attempt to perform action on inactive widget"
)))
;;; Helper functions.
;;
...
...
@@ -610,6 +637,8 @@ glyphs used when the widget is pushed and inactive, respectively."
(
let
((
ext
(
make-extent
(
point
)
(
1-
(
point
))))
(
help-echo
(
widget-get
widget
:help-echo
)))
(
set-extent-property
ext
'invisible
t
)
(
set-extent-property
ext
'start-open
t
)
(
set-extent-property
ext
'end-open
t
)
(
set-extent-end-glyph
ext
glyph
)
(
when
help-echo
(
set-extent-property
ext
'balloon-help
help-echo
)
...
...
@@ -745,13 +774,16 @@ The optional ARGS are additional keyword arguments."
(
apply
'insert
args
)
(
widget-specify-text
from
(
point
))))
(
defun
widget-convert-text
(
type
from
to
&optional
button-from
button-to
)
(
defun
widget-convert-text
(
type
from
to
&optional
button-from
button-to
&rest
args
)
"Return a widget of type TYPE with endpoint FROM TO.
No text will be inserted to the buffer, instead the text between FROM
Optional ARGS are extra keyword arguments for TYPE.
and TO will be used as the widgets end points. If optional arguments
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
button end points."
(
let
((
widget
(
widget-convert
type
))
button end points.
Optional ARGS are extra keyword arguments for TYPE."
(
let
((
widget
(
apply
'widget-convert
type
:delete
'widget-leave-text
args
))
(
from
(
copy-marker
from
))
(
to
(
copy-marker
to
)))
(
widget-specify-text
from
to
)
...
...
@@ -763,12 +795,26 @@ button end points."
(
widget-specify-button
widget
button-from
button-to
))
widget
))
(
defun
widget-convert-button
(
type
from
to
)
(
defun
widget-convert-button
(
type
from
to
&rest
args
)
"Return a widget of type TYPE with endpoint FROM TO.
Optional ARGS are extra keyword arguments for TYPE.
No text will be inserted to the buffer, instead the text between FROM
and TO will be used as the widgets end points, as well as the widgets
button end points."
(
widget-convert-text
type
from
to
from
to
))
(
apply
'widget-convert-text
type
from
to
from
to
args
))
(
defun
widget-leave-text
(
widget
)
"Remove markers and overlays from WIDGET and its children."
(
let
((
from
(
widget-get
widget
:from
))
(
to
(
widget-get
widget
:to
))
(
button
(
widget-get
widget
:button-overlay
))
(
field
(
widget-get
widget
:field-overlay
))
(
children
(
widget-get
widget
:children
)))
(
set-marker
from
nil
)
(
set-marker
to
nil
)
(
delete-overlay
button
)
(
delete-overlay
field
)
(
mapcar
'widget-leave-text
children
)))
;;; Keymap and Commands.
...
...
@@ -942,14 +988,29 @@ Recommended as a parent keymap for modes using widgets.")
(
when
(
commandp
command
)
(
call-interactively
command
))))))
(
defun
widget-tabable-at
(
&optional
pos
)
"Return the tabable widget at POS, or nil.
POS defaults to the value of (point)."
(
unless
pos
(
setq
pos
(
point
)))
(
let
((
widget
(
or
(
get-char-property
(
point
)
'button
)
(
get-char-property
(
point
)
'field
))))
(
if
widget
(
let
((
order
(
widget-get
widget
:tab-order
)))
(
if
order
(
if
(
>=
order
0
)
widget
nil
)
widget
))
nil
)))
(
defun
widget-move
(
arg
)
"Move point to the ARG next field or button.
ARG may be negative to move backward."
(
or
(
bobp
)
(
>
arg
0
)
(
backward-char
))
(
let
((
pos
(
point
))
(
number
arg
)
(
old
(
or
(
get-char-property
(
point
)
'button
)
(
get-char-property
(
point
)
'field
)))
(
old
(
widget-tabable-at
))
new
)
;; Forward.
(
while
(
>
arg
0
)
...
...
@@ -959,13 +1020,10 @@ ARG may be negative to move backward."
(
and
(
eq
pos
(
point
))
(
eq
arg
number
)
(
error
"No buttons or fields found"
))
(
let
((
new
(
or
(
get-char-property
(
point
)
'button
)
(
get-char-property
(
point
)
'field
))))
(
let
((
new
(
widget-tabable-at
)))
(
when
new
(
unless
(
eq
new
old
)
(
unless
(
and
(
widget-get
new
:tab-order
)
(
<
(
widget-get
new
:tab-order
)
0
))
(
setq
arg
(
1-
arg
)))
(
setq
arg
(
1-
arg
))
(
setq
old
new
)))))
;; Backward.
(
while
(
<
arg
0
)
...
...
@@ -975,16 +1033,13 @@ ARG may be negative to move backward."
(
and
(
eq
pos
(
point
))
(
eq
arg
number
)
(
error
"No buttons or fields found"
))
(
let
((
new
(
or
(
get-char-property
(
point
)
'button
)
(
get-char-property
(
point
)
'field
))))
(
let
((
new
(
widget-tabable-at
)))
(
when
new
(
unless
(
eq
new
old
)
(
unless
(
and
(
widget-get
new
:tab-order
)
(
<
(
widget-get
new
:tab-order
)
0
))
(
setq
arg
(
1+
arg
)))))))
(
while
(
or
(
get-char-property
(
point
)
'button
)
(
get-char-property
(
point
)
'field
))
(
backward-char
))
(
setq
arg
(
1+
arg
))))))
(
let
((
new
(
widget-tabable-at
)))
(
while
(
eq
(
widget-tabable-at
)
new
)
(
backward-char
)))
(
forward-char
))
(
widget-echo-help
(
point
))
(
run-hooks
'widget-move-hook
))
...
...
@@ -1074,7 +1129,7 @@ When not inside a field, move to the previous button or field."
(
widget-clear-undo
)
;; We need to maintain text properties and size of the editing fields.
(
make-local-variable
'after-change-functions
)
(
if
(
and
widget-field-list
)
(
if
widget-field-list
(
setq
after-change-functions
'
(
widget-after-change
))
(
setq
after-change-functions
nil
)))
...
...
@@ -1100,7 +1155,9 @@ When not inside a field, move to the previous button or field."
"Return the end of WIDGET's editing field."
(
let
((
overlay
(
widget-get
widget
:field-overlay
)))
;; Don't subtract one if local-map works at the end of the overlay.
(
and
overlay
(
1-
(
overlay-end
overlay
)))))
(
and
overlay
(
if
widget-field-add-space
(
1-
(
overlay-end
overlay
))
(
overlay-end
overlay
)))))
(
defun
widget-field-find
(
pos
)
"Return the field at POS.
...
...
@@ -1126,7 +1183,8 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
(
when
field
(
unless
(
eq
field
other
)
(
debug
"Change in different fields"
))
(
let
((
size
(
widget-get
field
:size
)))
(
let
((
size
(
widget-get
field
:size
))
(
secret
(
widget-get
field
:secret
)))
(
when
size
(
let
((
begin
(
widget-field-start
field
))
(
end
(
widget-field-end
field
)))
...
...
@@ -1147,7 +1205,20 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
(
goto-char
end
)
(
while
(
and
(
eq
(
preceding-char
)
?\
)
(
>
(
point
)
begin
))
(
delete-backward-char
1
))))))))
(
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-apply
field
:notify
field
)))
(
error
(
debug
"After Change"
))))
...
...
@@ -1320,7 +1391,8 @@ If that does not exists, call the value of `widget-complete-field'."
(
widget-get
widget
:value
)))))
(
doc-text
(
and
(
stringp
doc-try
)
(
>
(
length
doc-try
)
1
)
doc-try
)))
doc-try
))
(
doc-indent
(
widget-get
widget
:documentation-indent
)))
(
when
doc-text
(
and
(
eq
(
preceding-char
)
?\n
)
(
widget-get
widget
:indent
)
...
...
@@ -1333,6 +1405,11 @@ If that does not exists, call the value of `widget-complete-field'."
(
setq
doc-text
(
substring
doc-text
0
(
match-beginning
0
))))
(
push
(
widget-create-child-and-convert
widget
'documentation-string
:indent
(
cond
((
numberp
doc-indent
)
doc-indent
)
((
null
doc-indent
)
nil
)
(
t
0
))
doc-text
)
buttons
))))
(
t
...
...
@@ -2522,17 +2599,76 @@ when he invoked the menu."
(
widget-glyph-insert
widget
off
"right"
"right-pushed"
)
(
insert
"..."
))))
;;; The `documentation-string' Widget.
;;; The `documentation-link' Widget.
;;
;; This is a helper widget for `documentation-string'.
(
defface
widget-documentation-face
'
((((
class
color
)
(
background
dark
))
(
:foreground
"lime green"
))
(((
class
color
)
(
background
light
))
(
:foreground
"dark green"
))
(
t
nil
))
"Face used for documentation text."
:group
'widget-faces
)
(
define-widget
'documentation-link
'link
"Link type used in documentation strings."
:tab-order
-1
:help-echo
'widget-documentation-link-echo-help
:action
'widget-documentation-link-action
)
(
defun
widget-documentation-link-echo-help
(
widget
)
"Tell what this link will describe."
(
concat
"Describe the `"
(
widget-get
widget
:value
)
"' symbol."
))
(
defun
widget-documentation-link-action
(
widget
&optional
event
)
"Run apropos on WIDGET's value. Ignore optional argument EVENT."
(
apropos
(
concat
"\\`"
(
regexp-quote
(
widget-get
widget
:value
))
"\\'"
)))
(
defcustom
widget-documentation-links
t
"Add hyperlinks to documentation strings when non-nil."
:type
'boolean
:group
'widget-documentation
)
(
defcustom
widget-documentation-link-regexp
"`\\([^\n`' ]+\\)'"
"Regexp for matching potential links in documentation strings.
The first group should be the link itself."
:type
'regexp
:group
'widget-documentation
)
(
defcustom
widget-documentation-link-p
'intern-soft
"Predicate used to test if a string is useful as a link.
The value should be a function. The function will be called one
argument, a string, and should return non-nil if there should be a
link for that string."
:type
'function
:options
'
(
widget-documentation-link-p
)
:group
'widget-documentation
)
(
defcustom
widget-documentation-link-type
'documentation-link
"Widget type used for links in documentation strings."
:type
'symbol
:group
'widget-documentation
)
(
defun
widget-documentation-link-add
(
widget
from
to
)
(
widget-specify-doc
widget
from
to
)
(
when
widget-documentation-links
(
let
((
regexp
widget-documentation-link-regexp
)
(
predicate
widget-documentation-link-p
)
(
type
widget-documentation-link-type
)
(
buttons
(
widget-get
widget
:buttons
)))
(
save-excursion
(
goto-char
from
)
(
while
(
re-search-forward
regexp
to
t
)
(
let
((
name
(
match-string
1
))
(
begin
(
match-beginning
0
))
(
end
(
match-end
0
)))
(
when
(
funcall
predicate
name
)
(
push
(
widget-convert-button
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
?\
indent
)))))))
;;; The `documentation-string' Widget.
(
define-widget
'documentation-string
'item
"A documentation string."
...
...
@@ -2544,6 +2680,7 @@ when he invoked the menu."
(
defun
widget-documentation-string-value-create
(
widget
)
;; Insert documentation string.
(
let
((
doc
(
widget-value
widget
))
(
indent
(
widget-get
widget
:indent
))
(
shown
(
widget-get
(
widget-get
widget
:parent
)
:documentation-shown
))
(
start
(
point
)))
(
if
(
string-match
"\n"
doc
)
...
...
@@ -2551,20 +2688,23 @@ when he invoked the menu."
(
after
(
substring
doc
(
match-beginning
0
)))
buttons
)
(
insert
before
" "
)
(
widget-
specify-doc
widget
start
(
point
))
(
widget-
documentation-link-add
widget
start
(
point
))
(
push
(
widget-create-child-and-convert
widget
'visibility
:help-echo
"Show or hide rest of the documentation."
:off
nil
:action
'widget-parent-action
shown
)
buttons
)
(
when
shown
(
setq
start
(
point
))
(
when
(
and
indent
(
not
(
zerop
indent
)))
(
insert-char
?\
indent
))
(
insert
after
)
(
widget-
specify-doc
widget
start
(
point
)))
(
widget-
documentation-link-add
widget
start
(
point
)))
(
widget-put
widget
:buttons
buttons
))
(
insert
doc
)
(
widget-
specify-doc
widget
start
(
point
))))
(
widget-
documentation-link-add
widget
start
(
point
))))
(
insert
"\n"
))
(
defun
widget-documentation-string-action
(
widget
&rest
ignore
)
...
...
@@ -2902,7 +3042,9 @@ It will read a directory name from the minibuffer when invoked."
(
define-widget
'choice
'menu-choice
"A union of several sexp types."
:tag
"Choice"
:format
"%[%t%]: %v"
:format
"%{%t%}: %[value menu%] %v"
:button-prefix
'widget-push-button-prefix
:button-suffix
'widget-push-button-suffix
:prompt-value
'widget-choice-prompt-value
)
(
defun
widget-choice-prompt-value
(
widget
prompt
value
unbound
)
...
...
@@ -2967,7 +3109,9 @@ It will read a directory name from the minibuffer when invoked."
"To be nil or non-nil, that is the question."
:tag
"Boolean"
:prompt-value
'widget-boolean-prompt-value
:format
"%[%t%]: %v\n"
)
:button-prefix
'widget-push-button-prefix
:button-suffix
'widget-push-button-suffix
:format
"%{%t%}: %[toggle%] %v\n"
)
(
defun
widget-boolean-prompt-value
(
widget
prompt
value
unbound
)
;; Toggle a boolean.
...
...
lisp/widget.el
View file @
8697863a
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
;; Version: 1.990
8
;; Version: 1.99
2
0
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -44,7 +44,8 @@
(
set
(
car
keywords
)
(
car
keywords
)))
(
setq
keywords
(
cdr
keywords
)))))))
(
define-widget-keywords
:complete-function
:complete
:button-overlay
(
define-widget-keywords
:documentation-indent
:complete-function
:complete
:button-overlay
:field-overlay
:documentation-shown
:button-prefix
:button-suffix
:mouse-down-action
:glyph-up
:glyph-down
:glyph-inactive
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment