Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
6aaedd12
Commit
6aaedd12
authored
Jun 14, 1997
by
Per Abrahamsen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Synched with 1.9914.
parent
99616935
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
220 additions
and
97 deletions
+220
-97
lisp/cus-edit.el
lisp/cus-edit.el
+84
-53
lisp/wid-browse.el
lisp/wid-browse.el
+2
-2
lisp/wid-edit.el
lisp/wid-edit.el
+134
-42
No files found.
lisp/cus-edit.el
View file @
6aaedd12
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.99
08
;; Version: 1.99
14
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -246,6 +246,16 @@
:group
'customize
:group
'faces
)
(
defgroup
custom-buffer
nil
"Control the customize buffers."
:prefix
"custom-"
:group
'customize
)
(
defgroup
custom-menu
nil
"Control how the customize menus."
:prefix
"custom-"
:group
'customize
)
(
defgroup
abbrev-mode
nil
"Word abbreviations mode."
:group
'abbrev
)
...
...
@@ -401,7 +411,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
(
defcustom
custom-unlispify-menu-entries
t
"Display menu entries as words instead of symbols if non nil."
:group
'custom
ize
:group
'custom
-menu
:type
'boolean
)
(
defun
custom-unlispify-menu-entry
(
symbol
&optional
no-suffix
)
...
...
@@ -440,7 +450,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
(
defcustom
custom-unlispify-tag-names
t
"Display tag names as words instead of symbols if non nil."
:group
'custom
ize
:group
'custom
-buffer
:type
'boolean
)
(
defun
custom-unlispify-tag-name
(
symbol
)
...
...
@@ -518,49 +528,59 @@ if that fails, the doc string with `custom-guess-doc-alist'."
;;; Sorting.
(
defcustom
custom-buffer-sort-predicate
'
custom-buffer-sort-alphabetically
(
defcustom
custom-buffer-sort-predicate
'
ignore
"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
(
const
:tag
"Unsorted"
ignore
)
(
const
:tag
"Alphabetic"
custom-sort-items-alphabetically
)
(
function
:tag
"Other"
))
:group
'custom
ize
)
:group
'custom
-buffer
)
(
defun
custom-buffer-sort-alphabetically
(
a
b
)
"Return t iff is A should be before B.
A and B should be members of a `custom-group' property.
The members are sorted alphabetically, except that all groups are
sorted after all non-groups."
(
cond
((
and
(
eq
(
nth
1
a
)
'custom-group
)
(
not
(
eq
(
nth
1
b
)
'custom-group
)))
nil
)
((
and
(
eq
(
nth
1
b
)
'custom-group
)
(
not
(
eq
(
nth
1
a
)
'custom-group
)))
t
)
(
t
(
string-lessp
(
symbol-name
(
nth
0
a
))
(
symbol-name
(
nth
0
b
))))))
(
defcustom
custom-buffer-order-predicate
'custom-sort-groups-last
"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
(
const
:tag
"Groups first"
custom-sort-groups-first
)
(
const
:tag
"Groups last"
custom-sort-groups-last
)
(
function
:tag
"Other"
))
:group
'custom-buffer
)
(
defcustom
custom-menu-sort-predicate
'
custom-menu-sort-alphabetically
(
defcustom
custom-menu-sort-predicate
'
ignore
"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
(
const
:tag
"Unsorted"
ignore
)
(
const
:tag
"Alphabetic"
custom-sort-items-alphabetically
)
(
function
:tag
"Other"
))
:group
'custom
ize
)
:group
'custom
-menu
)
(
defun
custom-menu-sort-alphabetically
(
a
b
)
"Return t iff is A should be before B.
A and B should be members of a `custom-group' property.
The members are sorted alphabetically, except that all groups are
sorted before all non-groups."
(
cond
((
and
(
eq
(
nth
1
a
)
'custom-group
)
(
not
(
eq
(
nth
1
b
)
'custom-group
)))
t
)
((
and
(
eq
(
nth
1
b
)
'custom-group
)
(
not
(
eq
(
nth
1
a
)
'custom-group
)))
nil
)
(
t
(
string-lessp
(
symbol-name
(
nth
0
a
))
(
symbol-name
(
nth
0
b
))))))
(
defcustom
custom-menu-order-predicate
'custom-sort-groups-first
"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
(
const
:tag
"Groups first"
custom-sort-groups-first
)
(
const
:tag
"Groups last"
custom-sort-groups-last
)
(
function
:tag
"Other"
))
:group
'custom-menu
)
(
defun
custom-sort-items-alphabetically
(
a
b
)
"Return t iff A is alphabetically before B and the same custom type.
A and B should be members of a `custom-group' property."
(
and
(
eq
(
nth
1
a
)
(
nth
1
b
))
(
string-lessp
(
symbol-name
(
nth
0
a
))
(
symbol-name
(
nth
0
b
)))))
(
defun
custom-sort-groups-first
(
a
b
)
"Return t iff A a custom group and B is a not.
A and B should be members of a `custom-group' property."
(
and
(
eq
(
nth
1
a
)
'custom-group
)
(
not
(
eq
(
nth
1
b
)
'custom-group
))))
(
defun
custom-sort-groups-last
(
a
b
)
"Return t iff B a custom group and A is a not.
A and B should be members of a `custom-group' property."
(
and
(
eq
(
nth
1
b
)
'custom-group
)
(
not
(
eq
(
nth
1
a
)
'custom-group
))))
;;; Custom Mode Commands.
...
...
@@ -897,7 +917,7 @@ that option."
"If non-nil, only show a single reset button in customize buffers.
This button will have a menu with all three reset operations."
:type
'boolean
:group
'custom
ize
)
:group
'custom
-buffer
)
(
defun
custom-buffer-create-internal
(
options
)
(
message
"Creating customization buffer..."
)
...
...
@@ -1017,38 +1037,49 @@ Reset all visible items in this buffer to their standard settings."
;;; The `custom-magic' Widget.
(defgroup custom-magic-faces nil
"
Faces
used
by
the
magic
button.
"
:group 'custom-faces
:group 'custom-buffer)
(defface custom-invalid-face '((((class color))
(:foreground "
yellow
" :background "
red
"))
(t
(:bold t :italic t :underline t)))
"
Face
used
when
the
customize
item
is
invalid.
")
"
Face
used
when
the
customize
item
is
invalid.
"
:group 'custom-magic-faces)
(defface custom-rogue-face '((((class color))
(:foreground "
pink
" :background "
black
"))
(t
(:underline t)))
"
Face
used
when
the
customize
item
is
not
defined
for
customization.
")
"
Face
used
when
the
customize
item
is
not
defined
for
customization.
"
:group 'custom-magic-faces)
(defface custom-modified-face '((((class color))
(:foreground "
white
" :background "
blue
"))
(t
(:italic t :bold)))
"
Face
used
when
the
customize
item
has
been
modified.
")
"
Face
used
when
the
customize
item
has
been
modified.
"
:group 'custom-magic-faces)
(defface custom-set-face '((((class color))
(:foreground "
blue
" :background "
white
"))
(t
(:italic t)))
"
Face
used
when
the
customize
item
has
been
set.
")
"
Face
used
when
the
customize
item
has
been
set.
"
:group 'custom-magic-faces)
(defface custom-changed-face '((((class color))
(:foreground "
white
" :background "
blue
"))
(t
(:italic t)))
"
Face
used
when
the
customize
item
has
been
changed.
")
"
Face
used
when
the
customize
item
has
been
changed.
"
:group 'custom-magic-faces)
(defface custom-saved-face '((t (:underline t)))
"
Face
used
when
the
customize
item
has
been
saved.
")
"
Face
used
when
the
customize
item
has
been
saved.
"
:group 'custom-magic-faces)
(defconst custom-magic-alist '((nil "
#" underline "
\
uninitialized,
you
should
not
see
this.
")
...
...
@@ -1123,7 +1154,7 @@ If non-nil and not the symbol `long', only show first word."
:type '(choice (const :tag "
no
" nil)
(const short)
(const long))
:group 'custom
ize
)
:group 'custom
-buffer
)
(defcustom custom-magic-show-hidden '(option face)
"
Control
whether
the
state
button
is
shown
for
hidden
items.
...
...
@@ -1131,12 +1162,12 @@ The value should be a list with the custom categories where the state
button
should
be
visible.
Possible
categories
are
`
group
',
`
option
',
and
`
face
'.
"
:type '(set (const group) (const option) (const face))
:group 'custom
ize
)
:group 'custom
-buffer
)
(defcustom custom-magic-show-button nil
"
Show
a
magic
button
indicating
the
state
of
each
customization
option.
"
:type 'boolean
:group 'custom
ize
)
:group 'custom
-buffer
)
(define-widget 'custom-magic 'default
"
Show
and
manipulate
state
for
a
customization
option.
"
...
...
@@ -2176,8 +2207,9 @@ and so forth. The remaining group tags are shown with
(custom-load-widget widget)
(let* ((level (widget-get widget :custom-level))
(symbol (widget-value widget))
(members (sort (get symbol 'custom-group)
custom-buffer-sort-predicate))
(members (sort (sort (copy-sequence (get symbol 'custom-group))
custom-buffer-sort-predicate)
custom-buffer-order-predicate))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
(length (length members))
...
...
@@ -2199,7 +2231,6 @@ and so forth. The remaining group tags are shown with
(unless (eq (preceding-char) ?\n)
(widget-insert "
\n
"))))
members)))
(put symbol 'custom-group members)
(message "
Creating
group
magic...
")
(mapcar 'custom-magic-reset children)
(message "
Creating
group
state...
")
...
...
@@ -2465,7 +2496,7 @@ Leave point at the location of the call, or after the last expression."
(defcustom custom-menu-nesting 2
"
Maximum
nesting
in
custom
menus.
"
:type 'integer
:group 'custom
ize
)
:group 'custom
-menu
)
(defun custom-face-menu-create (widget symbol)
"
Ignoring
WIDGET,
create
a
menu
entry
for
customization
face
SYMBOL.
"
...
...
@@ -2518,9 +2549,9 @@ The menu is in a format applicable to `easy-menu-define'."
(< (length (get symbol 'custom-group)) widget-menu-max-size))
(let ((custom-prefix-list (custom-prefix-add symbol
custom-prefix-list))
(members (sort (get symbol 'custom-group)
custom-menu-sort-predicate)
))
(put symbol 'custom-group members
)
(members (sort
(sort (copy-sequence
(get symbol 'custom-group)
)
custom-menu-sort-predicate)
custom-menu-order-predicate))
)
(custom-load-symbol symbol)
`(,(custom-unlispify-menu-entry symbol t)
,item
...
...
@@ -2579,7 +2610,7 @@ The format is suitable for use with `easy-menu-define'."
(defcustom custom-mode-hook nil
"
Hook
called
when
entering
custom-mode.
"
:type 'hook
:group 'custom
ize
)
:group 'custom
-buffer
)
(defun custom-mode ()
"
Major
mode
for
editing
customization
buffers.
...
...
lisp/wid-browse.el
View file @
6aaedd12
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.99
05
;; Version: 1.99
14
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -282,7 +282,7 @@ With arg, turn widget mode on if and only if arg is positive."
(
interactive
"P"
)
(
cond
((
null
arg
)
(
setq
widget-minor-mode
(
not
widget-minor-mode
)))
((
<=
0
arg
)
((
<=
arg
0
)
(
setq
widget-minor-mode
nil
))
(
t
(
setq
widget-minor-mode
t
)))
...
...
lisp/wid-edit.el
View file @
6aaedd12
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.99
08
;; Version: 1.99
14
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -123,17 +123,21 @@ is the string or buffer containing the text."
"http://www.dina.kvl.dk/~abraham/custom/"
)
:prefix
"widget-"
:group
'extensions
:group
'faces
:group
'hypermedia
)
(
defgroup
widget-faces
nil
"Faces used by the widget library."
:group
'widgets
:group
'faces
)
(
defface
widget-button-face
'
((
t
(
:bold
t
)))
"Face used for widget buttons."
:group
'widgets
)
:group
'widget
-face
s
)
(
defcustom
widget-mouse-face
'highlight
"Face used for widget buttons when the mouse is above them."
:type
'face
:group
'widgets
)
:group
'widget
-face
s
)
(
defface
widget-field-face
'
((((
class
grayscale
color
)
(
background
light
))
...
...
@@ -144,7 +148,7 @@ is the string or buffer containing the text."
(
t
(
:italic
t
)))
"Face used for editable fields."
:group
'widgets
)
:group
'widget
-face
s
)
;;; Utility functions.
;;
...
...
@@ -347,14 +351,15 @@ minibuffer."
(
t
(
:italic
t
)))
"Face used for inactive widgets."
:group
'widgets
)
:group
'widget
-face
s
)
(
defun
widget-specify-inactive
(
widget
from
to
)
"Make WIDGET inactive for user modifications."
(
unless
(
widget-get
widget
:inactive
)
(
let
((
overlay
(
make-overlay
from
to
nil
t
nil
)))
(
overlay-put
overlay
'face
'widget-inactive-face
)
(
overlay-put
overlay
'mouse-face
'widget-inactive-face
)
;; This is disabled, as it makes the mouse cursor change shape.
;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
(
overlay-put
overlay
'evaporate
t
)
(
overlay-put
overlay
'priority
100
)
(
overlay-put
overlay
(
if
(
string-match
"XEmacs"
emacs-version
)
...
...
@@ -474,6 +479,26 @@ This is only meaningful for radio buttons or checkboxes in a list."
(
throw
'child
child
)))
nil
)))
(
defun
widget-map-buttons
(
function
&optional
buffer
maparg
)
"Map FUNCTION over the buttons in BUFFER.
FUNCTION is called with the arguments WIDGET and MAPARG.
If FUNCTION returns non-nil, the walk is cancelled.
The arguments MAPARG, and BUFFER default to nil and (current-buffer),
respectively."
(
let
((
cur
(
point-min
))
(
widget
nil
)
(
parent
nil
)
(
overlays
(
if
buffer
(
save-excursion
(
set-buffer
buffer
)
(
overlay-lists
))
(
overlay-lists
))))
(
setq
overlays
(
append
(
car
overlays
)
(
cdr
overlays
)))
(
while
(
setq
cur
(
pop
overlays
))
(
setq
widget
(
overlay-get
cur
'button
))
(
if
(
and
widget
(
funcall
function
widget
maparg
))
(
setq
overlays
nil
)))))
;;; Glyphs.
(
defcustom
widget-glyph-directory
(
concat
data-directory
"custom/"
)
...
...
@@ -720,6 +745,31 @@ 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
)
"Return a widget of type TYPE with endpoint FROM TO.
No text will be inserted to the buffer, instead the text between FROM
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
))
(
from
(
copy-marker
from
))
(
to
(
copy-marker
to
)))
(
widget-specify-text
from
to
)
(
set-marker-insertion-type
from
t
)
(
set-marker-insertion-type
to
nil
)
(
widget-put
widget
:from
from
)
(
widget-put
widget
:to
to
)
(
when
button-from
(
widget-specify-button
widget
button-from
button-to
))
widget
))
(
defun
widget-convert-button
(
type
from
to
)
"Return a widget of type TYPE with endpoint FROM TO.
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
))
;;; Keymap and Commands.
(
defvar
widget-keymap
nil
...
...
@@ -783,7 +833,7 @@ Recommended as a parent keymap for modes using widgets.")
(
t
(
:bold
t
:underline
t
)))
"Face used for pressed buttons."
:group
'widgets
)
:group
'widget
-face
s
)
(
defun
widget-button-click
(
event
)
"Invoke button below mouse pointer."
...
...
@@ -1017,7 +1067,8 @@ When not inside a field, move to the previous button or field."
widget-field-list
(
cons
field
widget-field-list
))
(
let
((
from
(
car
(
widget-get
field
:field-overlay
)))
(
to
(
cdr
(
widget-get
field
:field-overlay
))))
(
widget-specify-field
field
from
to
)
(
widget-specify-field
field
(
marker-position
from
)
(
marker-position
to
))
(
set-marker
from
nil
)
(
set-marker
to
nil
))))
(
widget-clear-undo
)
...
...
@@ -1037,16 +1088,19 @@ When not inside a field, move to the previous button or field."
(
defun
widget-field-buffer
(
widget
)
"Return the start of WIDGET's editing field."
(
overlay-buffer
(
widget-get
widget
:field-overlay
)))
(
let
((
overlay
(
widget-get
widget
:field-overlay
)))
(
and
overlay
(
overlay-buffer
overlay
))))
(
defun
widget-field-start
(
widget
)
"Return the start of WIDGET's editing field."
(
overlay-start
(
widget-get
widget
:field-overlay
)))
(
let
((
overlay
(
widget-get
widget
:field-overlay
)))
(
and
overlay
(
overlay-start
overlay
))))
(
defun
widget-field-end
(
widget
)
"Return the end of WIDGET's editing field."
;; Don't subtract one if local-map works at the end of the overlay.
(
1-
(
overlay-end
(
widget-get
widget
:field-overlay
))))
(
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
)))))
(
defun
widget-field-find
(
pos
)
"Return the field at POS.
...
...
@@ -1253,32 +1307,34 @@ If that does not exists, call the value of `widget-complete-field'."
(
defun
widget-default-format-handler
(
widget
escape
)
;; We recognize the %h escape by default.
(
let*
((
buttons
(
widget-get
widget
:buttons
))
(
doc-property
(
widget-get
widget
:documentation-property
))
(
doc-try
(
cond
((
widget-get
widget
:doc
))
((
symbolp
doc-property
)
(
documentation-property
(
widget-get
widget
:value
)
doc-property
))
(
t
(
funcall
doc-property
(
widget-get
widget
:value
)))))
(
doc-text
(
and
(
stringp
doc-try
)
(
>
(
length
doc-try
)
1
)
doc-try
)))
(
let*
((
buttons
(
widget-get
widget
:buttons
)))
(
cond
((
eq
escape
?h
)
(
when
doc-text
(
and
(
eq
(
preceding-char
)
?\n
)
(
widget-get
widget
:indent
)
(
insert-char
?
(
widget-get
widget
:indent
)))
;; The `*' in the beginning is redundant.
(
when
(
eq
(
aref
doc-text
0
)
?*
)
(
setq
doc-text
(
substring
doc-text
1
)))
;; Get rid of trailing newlines.
(
when
(
string-match
"\n+\\'"
doc-text
)
(
setq
doc-text
(
substring
doc-text
0
(
match-beginning
0
))))
(
push
(
widget-create-child-and-convert
widget
'documentation-string
doc-text
)
buttons
)))
(
let*
((
doc-property
(
widget-get
widget
:documentation-property
))
(
doc-try
(
cond
((
widget-get
widget
:doc
))
((
symbolp
doc-property
)
(
documentation-property
(
widget-get
widget
:value
)
doc-property
))
(
t
(
funcall
doc-property
(
widget-get
widget
:value
)))))
(
doc-text
(
and
(
stringp
doc-try
)
(
>
(
length
doc-try
)
1
)
doc-try
)))
(
when
doc-text
(
and
(
eq
(
preceding-char
)
?\n
)
(
widget-get
widget
:indent
)
(
insert-char
?
(
widget-get
widget
:indent
)))
;; The `*' in the beginning is redundant.
(
when
(
eq
(
aref
doc-text
0
)
?*
)
(
setq
doc-text
(
substring
doc-text
1
)))
;; Get rid of trailing newlines.
(
when
(
string-match
"\n+\\'"
doc-text
)
(
setq
doc-text
(
substring
doc-text
0
(
match-beginning
0
))))
(
push
(
widget-create-child-and-convert
widget
'documentation-string
doc-text
)
buttons
))))
(
t
(
error
"Unknown escape `%c'"
escape
)))
(
widget-put
widget
:buttons
buttons
)))
...
...
@@ -2476,7 +2532,7 @@ when he invoked the menu."
(
:foreground
"dark green"
))
(
t
nil
))
"Face used for documentation text."
:group
'widgets
)
:group
'widget
-face
s
)
(
define-widget
'documentation-string
'item
"A documentation string."
...
...
@@ -2488,11 +2544,11 @@ when he invoked the menu."
(
defun
widget-documentation-string-value-create
(
widget
)
;; Insert documentation string.
(
let
((
doc
(
widget-value
widget
))
(
shown
(
widget-get
(
widget-get
widget
:parent
)
:documentation-shown
)))
(
shown
(
widget-get
(
widget-get
widget
:parent
)
:documentation-shown
))
(
start
(
point
)))
(
if
(
string-match
"\n"
doc
)
(
let
((
before
(
substring
doc
0
(
match-beginning
0
)))
(
after
(
substring
doc
(
match-beginning
0
)))
(
start
(
point
))
buttons
)
(
insert
before
" "
)
(
widget-specify-doc
widget
start
(
point
))
...
...
@@ -2507,7 +2563,8 @@ when he invoked the menu."
(
insert
after
)
(
widget-specify-doc
widget
start
(
point
)))
(
widget-put
widget
:buttons
buttons
))
(
insert
doc
)))
(
insert
doc
)
(
widget-specify-doc
widget
start
(
point
))))
(
insert
"\n"
))
(
defun
widget-documentation-string-action
(
widget
&rest
ignore
)
...
...
@@ -2666,6 +2723,41 @@ It will read a directory name from the minibuffer when invoked."
: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'."
)
(
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
)))
)
(
define-widget
'sexp
'editable-field
"An arbitrary lisp expression."
:tag
"Lisp expression"
...
...
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