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
3acab5ef
Commit
3acab5ef
authored
May 31, 1997
by
Per Abrahamsen
Browse files
Synched with version 1.9901.
parent
166246f7
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
259 additions
and
144 deletions
+259
-144
lisp/cus-edit.el
lisp/cus-edit.el
+122
-61
lisp/wid-edit.el
lisp/wid-edit.el
+133
-79
lisp/widget.el
lisp/widget.el
+4
-4
No files found.
lisp/cus-edit.el
View file @
3acab5ef
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.990
0
;; Version: 1.990
1
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -517,7 +517,7 @@ if that fails, the doc string with `custom-guess-doc-alist'."
"Function used for sorting group members in buffers.
The value should be useful as a predicate for `sort'.
The list to be sorted is the value of the groups `custom-group' property."
:type
'
(
radio
(
function-item
'
custom-buffer-sort-alphabetically
)
:type
'
(
radio
(
function-item
custom-buffer-sort-alphabetically
)
(
function
:tag
"Other"
))
:group
'customize
)
...
...
@@ -539,7 +539,7 @@ sorted after all non-groups."
"Function used for sorting group members in menus.
The value should be useful as a predicate for `sort'.
The list to be sorted is the value of the groups `custom-group' property."
:type
'
(
radio
(
function-item
'
custom-menu-sort-alphabetically
)
:type
'
(
radio
(
function-item
custom-menu-sort-alphabetically
)
(
function
:tag
"Other"
))
:group
'customize
)
...
...
@@ -1028,8 +1028,8 @@ uninitialized, you should not see this.")
(unknown "
?
" italic "
\
unknown,
you
should
not
see
this.
")
(hidden "
-
" default "
\
hidden,
invoke
the
state
button
to
show.
" "
\
group
now
hidden,
invoke
the
state
button
to
show
contents.
")
hidden,
invoke
the
dots
above
to
show.
" "
\
group
now
hidden,
invoke
the
dots
above
to
show
contents.
")
(invalid "
x
" custom-invalid-face "
\
the
value
displayed
for
this
item
is
invalid
and
cannot
be
set.
")
(modified "
*
" custom-modified-face "
\
...
...
@@ -1088,12 +1088,18 @@ left out, ITEM-DESC will be used.
The
list
should
be
sorted
most
significant
first.
")
(defcustom custom-magic-show 'long
"
Show
long
description
of
the
state
of
each
customization
option.
"
"
If
non-nil,
show
textual
description
of
the
state.
If
non-nil
and
not
the
symbol
`
long
',
only
show
first
word.
"
:type '(choice (const :tag "
no
" nil)
(const short)
(const long))
:group 'customize)
(defcustom custom-magic-show-hidden nil
"
If
non-nil,
also
show
long
state
description
of
hidden
options.
"
:type 'boolean
:group 'customize)
(defcustom custom-magic-show-button nil
"
Show
a
magic
button
indicating
the
state
of
each
customization
option.
"
:type 'boolean
...
...
@@ -1118,6 +1124,7 @@ The list should be sorted most significant first.")
;; Create compact status report for WIDGET.
(let* ((parent (widget-get widget :parent))
(state (widget-get parent :custom-state))
(hidden (eq state 'hidden))
(entry (assq state custom-magic-alist))
(magic (nth 1 entry))
(face (nth 2 entry))
...
...
@@ -1126,13 +1133,14 @@ The list should be sorted most significant first.")
(nth 3 entry)))
(lisp (eq (widget-get parent :custom-form) 'lisp))
children)
(when custom-magic-show
(when (and custom-magic-show
(or custom-magic-show-hidden (not hidden)))
(insert "
")
(push (widget-create-child-and-convert
widget 'choice-item
:help-echo "
\
Change
the
state
of
this
item.
"
:format "
%[%t%]
"
:format
(if hidden "
%t
"
"
%[%t%]
"
)
:button-prefix 'widget-push-button-prefix
:button-suffix 'widget-push-button-suffix
:mouse-down-action 'widget-magic-mouse-down-action
...
...
@@ -1154,8 +1162,10 @@ Change the state of this item."
widget 'choice-item
:mouse-down-action 'widget-magic-mouse-down-action
:button-face face
:button-prefix ""
:button-suffix ""
:help-echo "
Change
the
state.
"
:format "
%[%t%]
"
:format
(if hidden "
%t
"
"
%[%t%]
"
)
:tag (if lisp
(concat "
(
" magic "
)
")
(concat "
[
" magic "
]
")))
...
...
@@ -1201,13 +1211,25 @@ Change the state of this item."
(level (widget-get widget :custom-level)))
(cond ((eq escape ?l)
(when level
(push (widget-create-child-and-convert
widget 'item :format "
%v
" (make-string level ?*))
buttons)
(widget-put widget :buttons buttons)))
(if (eq state 'hidden)
(insert-char ?- (* 2 level))
(insert "
/
" (make-string (1- (* 2 level)) ?-)))))
((eq escape ?e)
(when (and level (not (eq state 'hidden)))
(insert "
\n\\
" (make-string (1- (* 2 level)) ?-) "
"
(widget-get widget :tag) "
group
end
")
(insert (make-string (- 75 (current-column)) ?-) "
/\n
")))
((eq escape ?-)
(when level
(if (eq state 'hidden)
(insert-char ?- (- 77 (current-column)))
(insert (make-string (- 76 (current-column)) ?-) "
\\
"))))
((eq escape ?L)
(when (eq state 'hidden)
(widget-insert "
...
")))
(push (widget-create-child-and-convert
widget 'visibility
:action 'custom-toggle-parent
(not (eq state 'hidden)))
buttons))
((eq escape ?m)
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
...
...
@@ -1218,27 +1240,28 @@ Change the state of this item."
(push magic buttons)
(widget-put widget :buttons buttons)))
((eq escape ?a)
(let* ((symbol (widget-get widget :value))
(links (get symbol 'custom-links))
(many (> (length links) 2)))
(when links
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
(insert "
See
also
")
(while links
(push (widget-create-child-and-convert widget (car links))
buttons)
(setq links (cdr links))
(cond ((null links)
(insert "
.
\n
"))
((null (cdr links))
(if many
(insert "
,
and
")
(insert "
and
")))
(t
(insert "
,
"))))
(widget-put widget :buttons buttons))))
(unless (eq state 'hidden)
(let* ((symbol (widget-get widget :value))
(links (get symbol 'custom-links))
(many (> (length links) 2)))
(when links
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
(insert "
See
also
")
(while links
(push (widget-create-child-and-convert widget (car links))
buttons)
(setq links (cdr links))
(cond ((null links)
(insert "
.
\n
"))
((null (cdr links))
(if many
(insert "
,
and
")
(insert "
and
")))
(t
(insert "
,
"))))
(widget-put widget :buttons buttons)))))
(t
(widget-default-format-handler widget escape)))))
...
...
@@ -1329,9 +1352,14 @@ Change the state of this item."
((eq state 'hidden)
(widget-put widget :custom-state 'unknown))
(t
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)))
(custom-redraw widget)))
(defun custom-toggle-parent (widget &rest ignore)
"
Toggle
visibility
of
parent
to
WIDGET.
"
(custom-toggle-hide (widget-get widget :parent)))
;;; The `custom-variable' Widget.
(defface custom-variable-sample-face '((t (:underline t)))
...
...
@@ -1405,11 +1433,16 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
;; Indicate hidden value.
(push (widget-create-child-and-convert
widget 'item
:format "
%{%t%}:
...
"
:format "
%{%t%}:
"
:sample-face 'custom-variable-sample-face
:tag tag
:parent widget)
children))
buttons)
(push (widget-create-child-and-convert
widget 'visibility
:action 'custom-toggle-parent
nil)
buttons))
((eq form 'lisp)
;; In lisp mode edit the saved value when possible.
(let* ((value (cond ((get symbol 'saved-value)
...
...
@@ -1420,22 +1453,49 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(custom-quote (funcall get symbol)))
(t
(custom-quote (widget-get conv :value))))))
(insert (symbol-name symbol) "
:
")
(push (widget-create-child-and-convert
widget 'visibility
:action 'custom-toggle-parent
t)
buttons)
(insert "
")
(push (widget-create-child-and-convert
widget 'sexp
:button-face 'custom-variable-button-face
:format "
%v
"
:tag (symbol-name symbol)
:parent widget
:value value)
children)))
(t
;; Edit mode.
(push (widget-create-child-and-convert
widget type
:tag tag
:button-face 'custom-variable-button-face
:sample-face 'custom-variable-sample-face
:value value)
children)))
(let* ((format (widget-get type :format))
tag-format value-format)
(unless (string-match "
:
" format)
(error "
Bad
format.
"))
(setq tag-format (substring format 0 (match-end 0)))
(setq value-format (substring format (match-end 0)))
(push (widget-create-child-and-convert
widget 'item
:format tag-format
:action 'custom-tag-action
:mouse-down-action 'custom-tag-mouse-down-action
:button-face 'custom-variable-button-face
:sample-face 'custom-variable-sample-face
tag)
buttons)
(insert "
")
(push (widget-create-child-and-convert
widget 'visibility
:action 'custom-toggle-parent
t)
buttons)
(push (widget-create-child-and-convert
widget type
:format value-format
:value value)
children))))
;; Now update the state.
(unless (eq (preceding-char) ?\n)
(widget-insert "
\n
"))
...
...
@@ -1446,6 +1506,16 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(widget-put widget :buttons buttons)
(widget-put widget :children children)))
(defun custom-tag-action (widget &rest args)
"
Pass
:action
to
first
child
of
WIDGET
's
parent.
"
(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
:action args))
(defun custom-tag-mouse-down-action (widget &rest args)
"
Pass
:mouse-down-action
to
first
child
of
WIDGET
's
parent.
"
(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
:mouse-down-action args))
(defun custom-variable-state-set (widget)
"
Set
the
state
of
WIDGET.
"
(let* ((symbol (widget-value widget))
...
...
@@ -1476,10 +1546,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
(widget-put widget :custom-state state)))
(defvar custom-variable-menu
'(("
Hide
" custom-toggle-hide
(lambda (widget)
(not (memq (widget-get widget :custom-state) '(modified invalid)))))
("
Edit
" custom-variable-edit
'(("
Edit
" custom-variable-edit
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'edit))))
("
Edit
Lisp
" custom-variable-edit-lisp
...
...
@@ -1712,7 +1779,7 @@ Match frames with dark backgrounds.")
(define-widget 'custom-face 'custom
"
Customize
face.
"
:format "
%{%t%}:
%s%m%h%a%v
"
:format "
%{%t%}:
%s
%L\n
%m%h%a%v
"
:format-handler 'custom-face-format-handler
:sample-face 'custom-face-tag-face
:help-echo "
Set
or
reset
this
face.
"
...
...
@@ -1739,7 +1806,7 @@ Match frames with dark backgrounds.")
(copy-face 'custom-face-empty symbol))
(setq child (widget-create-child-and-convert
widget 'item
:format "
(
%{%t%}
)
\n
"
:format "
(
%{%t%}
)
"
:sample-face symbol
:tag "
sample
")))
(t
...
...
@@ -1813,10 +1880,7 @@ Match frames with dark backgrounds.")
(message "
Creating
face
editor...done
")))
(defvar custom-face-menu
'(("
Hide
" custom-toggle-hide
(lambda (widget)
(not (memq (widget-get widget :custom-state) '(modified invalid)))))
("
Edit
Selected
" custom-face-edit-selected
'(("
Edit
Selected
" custom-face-edit-selected
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'selected))))
("
Edit
All
" custom-face-edit-all
...
...
@@ -1955,7 +2019,7 @@ Optional EVENT is the location for the menu."
(let* ((symbol (widget-value widget))
(child (widget-create-child-and-convert
widget 'custom-face
:format "
%t
%s%m%h%v
"
:format "
%t
%s
%L\n
%m%h%v
"
:custom-level nil
:value symbol)))
(custom-magic-reset child)
...
...
@@ -2039,7 +2103,7 @@ and so forth. The remaining group tags are shown with
(define-widget 'custom-group 'custom
"
Customize
group.
"
:format "
%l%{%t%}
:%L
\n%m%h%a%v
"
:format "
%l
%{%t%}
group:
%L
%-
\n%m%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.
"
...
...
@@ -2096,10 +2160,7 @@ and so forth. The remaining group tags are shown with
(message "
Creating
group...
done
")))))
(defvar custom-group-menu
'(("
Hide
" custom-toggle-hide
(lambda (widget)
(not (memq (widget-get widget :custom-state) '(modified invalid)))))
("
Set
" custom-group-set
'(("
Set
" custom-group-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
("
Save
" custom-group-save
...
...
lisp/wid-edit.el
View file @
3acab5ef
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.990
0
;; Version: 1.990
1
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -31,6 +31,7 @@
;;; Code:
(
require
'widget
)
(
eval-when-compile
(
require
'cl
))
;;; Compatibility.
...
...
@@ -567,27 +568,23 @@ automatically."
(
repeat
:tag
"Suffixes"
(
string
:format
"%v"
)))))
(defun widget-glyph-insert (widget tag image)
"In WIDGET, insert the text TAG or, if supported, IMAGE.
IMAGE should either be a glyph, an image instantiator, or an image file
name sans extension (xpm, xbm, gif, jpg, or png) located in
`widget-glyph-directory'.
WARNING: If you call this with a glyph, and you want the user to be
able to invoke the glyph, make sure it is unique. If you use the
same glyph for multiple widgets, invoking any of the glyphs will
cause the last created widget to be invoked."
(cond ((not (and (string-match "XEmacs" emacs-version)
(
defun
widget-glyph-find
(
image
tag
)
"Create a glyph corresponding to IMAGE with string TAG as fallback.
IMAGE should either already be a glyph, or be a file name sans
extension (xpm, xbm, gif, jpg, or png) located in
`widget-glyph-directory'."
(
cond
((
not
(
and
image
(
string-match
"XEmacs"
emacs-version
)
widget-glyph-enable
(
fboundp
'make-glyph
)
(
fboundp
'locate-file
)
image
))
;; We don't want or can't use glyphs.
(insert tag)
)
nil
)
((
and
(
fboundp
'glyphp
)
(
glyphp
image
))
;; Already a glyph.
Insert
it.
(widget-glyph-insert-glyph widget
image)
)
;; Already a glyph.
Use
it.
image
)
((
stringp
image
)
;; A string. Look it up in relevant directories.
(
let*
((
dirlist
(
list
(
or
widget-glyph-directory
...
...
@@ -599,50 +596,65 @@ cause the last created widget to be invoked."
(
while
(
and
formats
(
not
file
))
(
if
(
valid-image-instantiator-format-p
(
car
(
car
formats
)))
(
setq
file
(
locate-file
image
dirlist
(mapconcat 'identity (cdr (car formats))
(
mapconcat
'identity
(
cdr
(
car
formats
))
":"
)))
(
setq
formats
(
cdr
formats
))))
;; We create a glyph with the file as the default image
;; instantiator, and the TAG fallback
(widget-glyph-insert-glyph
widget
(make-glyph (if file
(list (vector (car (car formats)) ':file file)
(vector 'string ':data tag))
(vector 'string ':data tag))))))
(
make-glyph
(
if
file
(
list
(
vector
(
car
(
car
formats
))
'
:file
file
)
(
vector
'string
'
:data
tag
))
(
vector
'string
'
:data
tag
)))))
((
valid-instantiator-p
image
'image
)
;; A valid image instantiator (e.g. [gif :file "somefile"] etc.)
(widget-glyph-insert-glyph
widget
(make-glyph (list image
(vector 'string ':data tag)))))
(
make-glyph
(
list
image
(
vector
'string
'
:data
tag
))))
(
t
;; Oh well.
(insert tag))))
nil
)))
(
defun
widget-glyph-insert
(
widget
tag
image
&optional
down
inactive
)
"In WIDGET, insert the text TAG or, if supported, IMAGE.
IMAGE should either be a glyph, an image instantiator, or an image file
name sans extension (xpm, xbm, gif, jpg, or png) located in
`widget-glyph-directory'.
Optional arguments DOWN and INACTIVE is used instead of IMAGE when the
glyph is pressed or inactive, respectively.
WARNING: If you call this with a glyph, and you want the user to be
able to invoke the glyph, make sure it is unique. If you use the
same glyph for multiple widgets, invoking any of the glyphs will
cause the last created widget to be invoked."
(
let
((
glyph
(
widget-glyph-find
image
tag
)))
(
if
glyph
(
widget-glyph-insert-glyph
widget
glyph
(
widget-glyph-find
down
tag
)
(
widget-glyph-find
inactive
tag
))
(
insert
tag
))))
(
defun
widget-glyph-insert-glyph
(
widget
glyph
&optional
down
inactive
)
"In WIDGET, with alternative text TAG, insert GLYPH."
"In WIDGET, insert GLYPH.
If optional arguments DOWN and INACTIVE are given, they should be
glyphs used when the widget is pushed and inactive, respectively."
(
set-glyph-property
glyph
'widget
widget
)
(
when
down
(
set-glyph-property
down
'widget
widget
))
(
when
inactive
(
set-glyph-property
inactive
'widget
widget
))
(
insert
"*"
)
(add-text-properties (1- (point)) (point)
(list 'invisible t
'end-glyph glyph))
(
let
((
ext
(
make-extent
(
point
)
(
1-
(
point
))))
(
help-echo
(
widget-get
widget
:help-echo
)))
(
set-extent-property
ext
'invisible
t
)
(
set-extent-end-glyph
ext
glyph
)
(
when
help-echo
(
set-extent-property
ext
'balloon-help
help-echo
)
(
set-extent-property
ext
'help-echo
help-echo
)))
(
widget-put
widget
:glyph-up
glyph
)
(
when
down
(
widget-put
widget
:glyph-down
down
))
(when inactive (widget-put widget :glyph-inactive inactive))
(let ((help-echo (widget-get widget :help-echo)))
(when help-echo
(let ((extent (extent-at (1- (point)) nil 'end-glyph))
(help-property (if (featurep 'balloon-help)
'balloon-help
'help-echo)))
(set-extent-property extent help-property (if (stringp help-echo)
help-echo
'widget-mouse-help))))))
(
when
inactive
(
widget-put
widget
:glyph-inactive
inactive
)))
;;; Buttons.
...
...
@@ -653,12 +665,12 @@ cause the last created widget to be invoked."
(
defcustom
widget-button-prefix
""
"String used as prefix for buttons."
:type
'string
:group 'widget
s
)
:group
'widget
-button
)
(
defcustom
widget-button-suffix
""
"String used as suffix for buttons."
:type
'string
:group 'widget
s
)
:group
'widget
-button
)
(
defun
widget-button-insert-indirect
(
widget
key
)
"Insert value of WIDGET's KEY property."
...
...
@@ -1313,20 +1325,10 @@ Optional EVENT is the event that triggered the action."
;; Get rid of trailing newlines.
(
when
(
string-match
"\n+\\'"
doc-text
)
(
setq
doc-text
(
substring
doc-text
0
(
match-beginning
0
))))
(setq buttons
(cons (if (string-match "\n." doc-text)
;; Allow multiline doc to be hiden.
(widget-create-child-and-convert
widget 'widget-help
:doc (progn
(string-match "\\`.*" doc-text)
(match-string 0 doc-text))
:widget-doc doc-text
"?")
;; A single line is just inserted.
(widget-create-child-and-convert
widget 'item :format "%d" :doc doc-text nil))
buttons))))
(
push
(
widget-create-child-and-convert
widget
'documentation-string
doc-text
)
buttons
)))
(
t
(
error
"Unknown escape `%c'"
escape
)))
(
widget-put
widget
:buttons
buttons
)))
...
...
@@ -1495,8 +1497,7 @@ If END is omitted, it defaults to the length of LIST."
(
progn
(
unless
gui
(
setq
gui
(
make-gui-button
tag
'widget-gui-action
widget
))
(setq widget-push-button-cache
(cons (cons tag gui) widget-push-button-cache)))
(
push
(
cons
tag
gui
)
widget-push-button-cache
))
(
widget-glyph-insert-glyph
widget
(
make-glyph
(
list
(
nth
0
(
aref
gui
1
))
...
...
@@ -2451,14 +2452,13 @@ when he invoked the menu."
(
and
(
eq
(
preceding-char
)
?\n
)
(
widget-get
widget
:indent
)
(
insert-char
?
(
widget-get
widget
:indent
)))
(setq children
(cons (cond ((null answer)
(widget-create-child widget arg))
((widget-get arg :inline)
(widget-create-child-value widget arg (car answer)))
(t
(widget-create-child-value widget arg (car (car answer)))))
children)))
(
push
(
cond
((
null
answer
)
(
widget-create-child
widget
arg
))
((
widget-get
arg
:inline
)
(
widget-create-child-value
widget
arg
(
car
answer
)))
(
t
(
widget-create-child-value
widget
arg
(
car
(
car
answer
)))))
children
))
(
widget-put
widget
:children
(
nreverse
children
))))
(
defun
widget-group-match
(
widget
values
)
...
...
@@ -2484,20 +2484,74 @@ when he invoked the menu."
(
cons
found
vals
)
nil
)))
;;; The `
widget-help
' Widget.
;;; The `
visibility
' Widget.
(define-widget 'widget-help 'push-button
"The widget documentation button."
:format "%[%v%] %d"
:help-echo "Toggle display of documentation."
:action 'widget-help-action)
(
define-widget
'visibility
'item
"An indicator and manipulator for hidden items."
:format
"%[%v%]"
:button-prefix
""
:button-suffix
""
:on
"hide"
:off
"more"
:value-create
'widget-visibility-value-create
:action
'widget-toggle-action
:match
(
lambda
(
widget
value
)
t
))
(defun widget-help-action (widget &optional event)
"Toggle documentation for WIDGET."
(let ((old (widget-get widget :doc))
(new (widget-get widget :widget-doc)))
(widget-put widget :doc new)
(widget-put widget :widget-doc old))
(
defun
widget-visibility-value-create
(
widget
)
;; Insert text representing the `on' and `off' states.
(
let
((
on
(
widget-get
widget
:on
))
(
off
(
widget-get
widget
:off
)))
(
if
on
(
setq
on
(
concat
widget-push-button-prefix
on
widget-push-button-suffix
))
(
setq
on
""
))
(
if
off
(
setq
off
(
concat
widget-push-button-prefix
off
widget-push-button-suffix
))
(
setq
off
""
))
(
if
(
widget-value
widget
)
(
widget-glyph-insert
widget
on
"down"
"down-pushed"
)
(
widget-glyph-insert
widget
off
"right"
"right-pushed"
)
(
insert
"..."
))))
;;; The `documentation-string' Widget.
(
define-widget
'documentation-string
'item
"A documentation string."
:format
"%v"
:action
'widget-documentation-string-action
:value-delete
'widget-children-value-delete
:value-create
'widget-documentation-string-value-create
)
(
defun
widget-documentation-string-value-create
(
widget
)
;; Insert documentation string.
(
let
((
doc
(
widget-value
widget
))
(
shown
(
widget-get
(
widget-get
widget
:parent
)
:documentation-shown
)))
(
if
(
string-match
"\n"
doc
)
(
let
((
before
(
substring
doc
0
(
match-beginning
0
)))
(
after
(
substring
doc
(
match-beginning
0
)))
buttons
)
(
insert
before
" "
)
(
push
(
widget-create-child-and-convert
widget
'visibility
:off
nil
:action
'widget-parent-action
shown
)
buttons
)
(
when
shown
(
insert
after
))
(
widget-put
widget
:buttons
buttons
))
(
insert
doc
)))
(
insert
"\n"
))
(
defun
widget-documentation-string-action
(
widget
&rest
ignore
)
;; Toggle documentation.
(
let
((
parent
(
widget-get
widget
:parent
)))
(
widget-put
parent
:documentation-shown
(
not
(
widget-get
parent