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
9097aeb7
Commit
9097aeb7
authored
Jun 01, 1997
by
Per Abrahamsen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Synched with 1.9904
parent
152c1d7c
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
87 additions
and
38 deletions
+87
-38
lisp/cus-edit.el
lisp/cus-edit.el
+66
-25
lisp/wid-edit.el
lisp/wid-edit.el
+18
-11
lisp/widget.el
lisp/widget.el
+3
-2
No files found.
lisp/cus-edit.el
View file @
9097aeb7
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.990
3
;; Version: 1.990
4
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -33,7 +33,6 @@
;;; Code:
(
require
'cus-face
)
(
require
'cus-start
)
(
require
'wid-edit
)
(
require
'easymenu
)
(
eval-when-compile
(
require
'cl
))
...
...
@@ -42,7 +41,12 @@
(
require
'cus-load
)
(
error
nil
))
(
define-widget-keywords
:custom-prefixes
:custom-menu
:custom-show
(
condition-case
nil
(
require
'cus-start
)
(
error
nil
))
(
define-widget-keywords
:custom-category
:custom-prefixes
:custom-menu
:custom-show
:custom-magic
:custom-state
:custom-level
:custom-form
:custom-set
:custom-save
:custom-reset-current
:custom-reset-saved
:custom-reset-standard
)
...
...
@@ -600,7 +604,7 @@ when the action is chosen.")
(
if
answer
(
funcall
answer
))))
(
defun
custom-reset-current
()
(
defun
custom-reset-current
(
&rest
ignore
)
"Reset all modified group members to their current value."
(
interactive
)
(
let
((
children
custom-options
))
...
...
@@ -609,7 +613,7 @@ when the action is chosen.")
(
widget-apply
child
:custom-reset-current
)))
children
)))
(
defun
custom-reset-saved
()
(
defun
custom-reset-saved
(
&rest
ignore
)
"Reset all modified or set group members to their saved value."
(
interactive
)
(
let
((
children
custom-options
))
...
...
@@ -618,7 +622,7 @@ when the action is chosen.")
(
widget-apply
child
:custom-reset-current
)))
children
)))
(
defun
custom-reset-standard
()
(
defun
custom-reset-standard
(
&rest
ignore
)
"Reset all modified, set, or saved group members to their standard settings."
(
interactive
)
(
let
((
children
custom-options
))
...
...
@@ -740,7 +744,8 @@ are shown; the contents of those subgroups are initially hidden."
(
list
(
list
symbol
'custom-group
))
(
format
"*Customize Group: %s*"
(
custom-unlispify-tag-name
symbol
))))
;;;### (defalias 'customize-variable 'customize-option)
;;;###autoload
(
defalias
'customize-variable
'customize-option
)
;;;###autoload
(
defun
customize-option
(
symbol
)
...
...
@@ -884,7 +889,12 @@ that option."
(
switch-to-buffer-other-window
(
get-buffer-create
name
))
(
custom-buffer-create-internal
options
)
(
select-window
window
)))
(
defcustom
custom-reset-button-menu
nil
"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
'customize
)
(
defun
custom-buffer-create-internal
(
options
)
(
message
"Creating customization buffer..."
)
...
...
@@ -911,11 +921,27 @@ Make the modifications default for future sessions."
:action (lambda (widget &optional event)
(custom-save)))
(widget-insert "
")
(widget-create 'push-button
:tag "
Reset
"
:help-echo "
Undo
all
modifications.
"
:action (lambda (widget &optional event)
(custom-reset event)))
(if custom-reset-button-menu
(widget-create 'push-button
:tag "
Reset
"
:help-echo "
Undo
all
modifications.
"
:mouse-down-action (lambda (&rest junk) t)
:action (lambda (widget &optional event)
(custom-reset event)))
(widget-create 'push-button
:tag "
Reset
"
:help-echo "
Undo
all
modifications.
"
:action 'custom-reset-current)
(widget-insert "
")
(widget-create 'push-button
:tag "
Reset
to
Saved
"
:help-echo "
Undo
all
modifications.
"
:action 'custom-reset-saved)
(widget-insert "
")
(widget-create 'push-button
:tag "
Reset
to
Standard
"
:help-echo "
Undo
all
modifications.
"
:action 'custom-reset-standard))
(widget-insert "
")
(widget-create 'push-button
:tag "
Done
"
...
...
@@ -1034,24 +1060,24 @@ unknown, you should not see this.")
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.
")
the
value
displayed
for
this
%c
is
invalid
and
cannot
be
set.
")
(modified "
*
" custom-modified-face "
\
you
have
edited
the
item
,
and
can
now
set
i
t.
" "
\
you
have
edited
the
value
,
and
can
now
set
t
he
%c
.
" "
\
you
have
edited
something
in
this
group,
and
can
now
set
it.
")
(set "
+
" custom-set-face "
\
you
have
set
this
item
,
but
not
saved
it.
" "
\
you
have
set
this
%c
,
but
not
saved
it.
" "
\
something
in
this
group
has
been
set,
but
not
yet
saved.
")
(changed "
:
" custom-changed-face "
\
this
item
has
been
changed
outside
customize.
" "
\
this
%c
has
been
changed
outside
the
customize
buffer
.
" "
\
something
in
this
group
has
been
changed
outside
customize.
")
(saved "
!
" custom-saved-face "
\
this
item
has
been
set
and
saved.
" "
\
this
%c
has
been
set
and
saved.
" "
\
something
in
this
group
has
been
set
and
saved.
")
(rogue "
@
" custom-rogue-face "
\
this
item
has
not
been
changed
with
customize.
" "
\
this
%c
has
not
been
changed
with
customize.
" "
\
something
in
this
group
is
not
prepared
for
customization.
")
(standard "
" nil "
\
this
item
is
unchanged
from
its
standard
setting.
" "
\
this
%c
is
unchanged
from
its
standard
setting.
" "
\
the
visible
members
of
this
group
are
all
at
standard
settings.
"))
"
Alist
of
customize
option
states.
Each
entry
is
of
the
form
(
STATE
MAGIC
FACE
ITEM-DESC
[
GROUP-DESC
]
)
,
where
...
...
@@ -1088,6 +1114,9 @@ ITEM-DESC is a string describing the state for options.
GROUP-DESC
is
a
string
describing
the
state
for
groups.
If
this
is
left
out,
ITEM-DESC
will
be
used.
The
string
%c
in
either
description
will
be
replaced
with
the
category
of
the
item.
These
are
`
group
'.
`
option
',
and
`
face
'.
The
list
should
be
sorted
most
significant
first.
")
(defcustom custom-magic-show 'long
...
...
@@ -1098,9 +1127,12 @@ If non-nil and not the symbol `long', only show first word."
(const long))
:group 'customize)
(defcustom custom-magic-show-hidden nil
"
If
non-nil,
also
show
long
state
description
of
hidden
options.
"
:type 'boolean
(defcustom custom-magic-show-hidden '(option face)
"
Control
whether
the
state
button
is
shown
for
hidden
items.
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 'customize)
(defcustom custom-magic-show-button nil
...
...
@@ -1131,13 +1163,19 @@ If non-nil and not the symbol `long', only show first word."
(entry (assq state custom-magic-alist))
(magic (nth 1 entry))
(face (nth 2 entry))
(text (or (and (eq (widget-type parent) 'custom-group)
(category (widget-get parent :custom-category))
(text (or (and (eq category 'group)
(nth 4 entry))
(nth 3 entry)))
(lisp (eq (widget-get parent :custom-form) 'lisp))
children)
(while (string-match "
\\
`
\\
(
.
*\\
)
%c\\
(
.
*\\
)
\\
'
" text)
(setq text (concat (match-string 1 text)
(symbol-name category)
(match-string 2 text))))
(when (and custom-magic-show
(or custom-magic-show-hidden (not hidden)))
(or (not hidden)
(memq category custom-magic-show-hidden)))
(insert "
")
(push (widget-create-child-and-convert
widget 'choice-item
...
...
@@ -1383,6 +1421,7 @@ If non-nil and not the symbol `long', only show first word."
:format "
%v%m%h%a
"
:help-echo "
Set
or
reset
this
variable.
"
:documentation-property 'variable-documentation
:custom-category 'option
:custom-state nil
:custom-menu 'custom-variable-menu-create
:custom-form 'edit
...
...
@@ -1795,6 +1834,7 @@ Match frames with dark backgrounds.")
(face-doc-string face))
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-category 'face
:custom-form 'selected
:custom-set 'custom-face-set
:custom-save 'custom-face-save
...
...
@@ -2117,6 +2157,7 @@ and so forth. The remaining group tags are shown with
:help-echo "
Set
or
reset
all
members
of
this
group.
"
:value-create 'custom-group-value-create
:action 'custom-group-action
:custom-category 'group
:custom-set 'custom-group-set
:custom-save 'custom-group-save
:custom-reset-current 'custom-group-reset-current
...
...
lisp/wid-edit.el
View file @
9097aeb7
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.990
3
;; Version: 1.990
4
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -278,8 +278,8 @@ minibuffer."
'front-sticky
t
'rear-nonsticky
nil
;; XEmacs is non-sticky.
'start-open
nil
'end-open
nil
'start-open
t
'end-open
t
;; This is because `insert'
;; inherit sticky text properties
;; in XEmacs but not in Emacs.
...
...
@@ -334,10 +334,7 @@ minibuffer."
(
size
(
widget-get
widget
:size
))
(
face
(
or
(
widget-get
widget
:value-face
)
'widget-field-face
))
(
help-echo
(
widget-get
widget
:help-echo
))
(
help-property
(
if
(
featurep
'balloon-help
)
'balloon-help
'help-echo
)))
(
help-echo
(
widget-get
widget
:help-echo
)))
(
unless
(
or
(
stringp
help-echo
)
(
null
help-echo
))
(
setq
help-echo
'widget-mouse-help
))
...
...
@@ -360,7 +357,8 @@ minibuffer."
'read-only
nil
'keymap
map
'local-map
map
help-property
help-echo
'balloon-help
help-echo
'help-echo
help-echo
'face
face
))
(
when
secret
...
...
@@ -374,7 +372,8 @@ minibuffer."
(
unless
(
widget-get
widget
:size
)
(
add-text-properties
to
(
1+
to
)
(
list
'field
widget
help-property
help-echo
'balloon-help
help-echo
'help-echo
help-echo
'face
face
)))
(
add-text-properties
to
(
1+
to
)
(
list
'local-map
map
'keymap
map
))))
...
...
@@ -1369,9 +1368,15 @@ Optional EVENT is the event that triggered the action."
;; Remove widget from the buffer.
(
let
((
from
(
widget-get
widget
:from
))
(
to
(
widget-get
widget
:to
))
(
inactive-overlay
(
widget-get
widget
:inactive
))
(
button-overlay
(
widget-get
widget
:button-overlay
))
(
inhibit-read-only
t
)
after-change-functions
)
(
widget-apply
widget
:value-delete
)
(
when
inactive-overlay
(
delete-overlay
inactive-overlay
))
(
when
button-overlay
(
delete-overlay
button-overlay
))
(
when
(
<
from
to
)
;; Kludge: this doesn't need to be true for empty formats.
(
delete-region
from
to
))
...
...
@@ -1665,7 +1670,9 @@ If END is omitted, it defaults to the length of LIST."
(
when
(
widget-get
widget
:value-from
)
(
set-marker
(
widget-get
widget
:value-from
)
nil
))
(
when
(
widget-get
widget
:value-from
)
(
set-marker
(
widget-get
widget
:value-to
)
nil
)))
(
set-marker
(
widget-get
widget
:value-to
)
nil
))
(
when
(
widget-get
widget
:field-overlay
)
(
delete-overlay
(
widget-get
widget
:field-overlay
))))
(
defun
widget-field-value-get
(
widget
)
;; Return current text in editing field.
...
...
@@ -2513,7 +2520,7 @@ when he invoked the menu."
:button-prefix
""
:button-suffix
""
:on
"hide"
:off
"
more
"
:off
"
show
"
:value-create
'widget-visibility-value-create
:action
'widget-toggle-action
:match
(
lambda
(
widget
value
)
t
))
...
...
lisp/widget.el
View file @
9097aeb7
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
;; Version: 1.990
1
;; Version: 1.990
4
;; 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
:documentation-shown
:button-prefix
(
define-widget-keywords
:button-overlay
:field-overlay
:documentation-shown
:button-prefix
:button-suffix
:mouse-down-action
:glyph-up
:glyph-down
:glyph-inactive
:prompt-internal
:prompt-history
:prompt-match
:prompt-value
:deactivate
:active
...
...
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