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
a1a4fa22
Commit
a1a4fa22
authored
Jun 19, 1997
by
Per Abrahamsen
Browse files
Synched with 1.9924.
parent
0093dc5a
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
103 additions
and
42 deletions
+103
-42
lisp/cus-edit.el
lisp/cus-edit.el
+95
-37
lisp/wid-edit.el
lisp/wid-edit.el
+8
-5
No files found.
lisp/cus-edit.el
View file @
a1a4fa22
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.992
0
;; Version: 1.992
4
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -643,7 +643,7 @@ when the action is chosen.")
(
let
((
children
custom-options
))
(
mapcar
(
lambda
(
child
)
(
when
(
eq
(
widget-get
child
:custom-state
)
'modified
)
(
widget-apply
child
:custom-reset-
current
)))
(
widget-apply
child
:custom-reset-
saved
)))
children
)))
(
defun
custom-reset-standard
(
&rest
ignore
)
...
...
@@ -652,7 +652,7 @@ when the action is chosen.")
(
let
((
children
custom-options
))
(
mapcar
(
lambda
(
child
)
(
when
(
eq
(
widget-get
child
:custom-state
)
'modified
)
(
widget-apply
child
:custom-reset-
current
)))
(
widget-apply
child
:custom-reset-
standard
)))
children
)))
;;; The Customize Commands
...
...
@@ -801,10 +801,10 @@ If SYMBOL is nil, customize all faces."
(
let
((
found
nil
))
(
message
"Looking for faces..."
)
(
mapcar
(
lambda
(
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-face
)
found
))
)
(
nreverse
(
mapcar
'intern
(
push
(
list
symbol
'custom-face
)
found
))
(
nreverse
(
mapcar
'intern
(
sort
(
mapcar
'symbol-name
(
face-list
))
'string
<
))))
'string
-lessp
))))
(
custom-buffer-create
found
"*Customize Faces*"
))
(
if
(
stringp
symbol
)
...
...
@@ -838,11 +838,10 @@ If SYMBOL is nil, customize all faces."
(
mapatoms
(
lambda
(
symbol
)
(
and
(
get
symbol
'customized-face
)
(
custom-facep
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-face
)
found
))
)
(
push
(
list
symbol
'custom-face
)
found
))
(
and
(
get
symbol
'customized-value
)
(
boundp
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-variable
)
found
)))))
(
push
(
list
symbol
'custom-variable
)
found
))))
(
if
found
(
custom-buffer-create
found
"*Customize Customized*"
)
(
error
"No customized user options"
))))
...
...
@@ -855,11 +854,10 @@ If SYMBOL is nil, customize all faces."
(
mapatoms
(
lambda
(
symbol
)
(
and
(
get
symbol
'saved-face
)
(
custom-facep
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-face
)
found
))
)
(
push
(
list
symbol
'custom-face
)
found
))
(
and
(
get
symbol
'saved-value
)
(
boundp
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-variable
)
found
)))))
(
push
(
list
symbol
'custom-variable
)
found
))))
(
if
found
(
custom-buffer-create
found
"*Customize Saved*"
)
(
error
"No saved user options"
))))
...
...
@@ -867,27 +865,55 @@ If SYMBOL is nil, customize all faces."
;;;###autoload
(
defun
customize-apropos
(
regexp
&optional
all
)
"Customize all user options matching REGEXP.
If ALL (e.g., started with a prefix key), include options which are not
user-settable."
If ALL is `options', include only options.
If ALL is `faces', include only faces.
If ALL is `groups', include only groups.
If ALL is t (interactively, with prefix arg), include options which are not
user-settable, as well as faces and groups."
(
interactive
"sCustomize regexp: \nP"
)
(
let
((
found
nil
))
(
mapatoms
(
lambda
(
symbol
)
(
when
(
string-match
regexp
(
symbol-name
symbol
))
(
when
(
get
symbol
'custom-group
)
(
setq
found
(
cons
(
list
symbol
'custom-group
)
found
)))
(
when
(
custom-facep
symbol
)
(
setq
found
(
cons
(
list
symbol
'custom-face
)
found
)))
(
when
(
and
(
boundp
symbol
)
(
when
(
and
(
not
(
memq
all
'
(
faces
options
)))
(
get
symbol
'custom-group
))
(
push
(
list
symbol
'custom-group
)
found
))
(
when
(
and
(
not
(
memq
all
'
(
options
groups
)))
(
custom-facep
symbol
))
(
push
(
list
symbol
'custom-face
)
found
))
(
when
(
and
(
not
(
memq
all
'
(
groups
faces
)))
(
boundp
symbol
)
(
or
(
get
symbol
'saved-value
)
(
get
symbol
'standard-value
)
(
if
all
(
get
symbol
'variable-documentation
)
(
user-variable-p
symbol
))))
(
setq
found
(
cons
(
list
symbol
'custom-variable
)
found
))))))
(
if
found
(
custom-buffer-create
found
"*Customize Apropos*"
)
(
error
"No matches"
))))
(
if
(
memq
all
'
(
nil
options
))
(
user-variable-p
symbol
)
(
get
symbol
'variable-documentation
))))
(
push
(
list
symbol
'custom-variable
)
found
)))))
(
if
(
not
found
)
(
error
"No matches"
)
(
custom-buffer-create
(
sort
(
sort
found
;; Apropos should always be sorted.
'custom-sort-items-alphabetically
)
custom-buffer-order-predicate
)
"*Customize Apropos*"
))))
;;;###autoload
(
defun
customize-apropos-options
(
regexp
&optional
arg
)
"Customize all user options matching REGEXP.
With prefix arg, include options which are not user-settable."
(
interactive
"sCustomize regexp: \nP"
)
(
customize-apropos
regexp
(
or
arg
'options
)))
;;;###autoload
(
defun
customize-apropos-faces
(
regexp
)
"Customize all user faces matching REGEXP."
(
interactive
"sCustomize regexp: \n"
)
(
customize-apropos
regexp
'faces
))
;;;###autoload
(
defun
customize-apropos-groups
(
regexp
)
"Customize all user groups matching REGEXP."
(
interactive
"sCustomize regexp: \n"
)
(
customize-apropos
regexp
'groups
))
;;; Buffer.
...
...
@@ -1006,6 +1032,31 @@ Reset all visible items in this buffer to their standard settings."
options))))
(unless (eq (preceding-char) ?\n)
(widget-insert "
\n
"))
(when (= (length options) 1)
(message "
Creating
parent
links...
")
(let* ((entry (nth 0 options))
(name (nth 0 entry))
(type (nth 1 entry))
parents)
(mapatoms (lambda (symbol)
(let ((group (get symbol 'custom-group)))
(when (assq name group)
(when (eq type (nth 1 (assq name group)))
(push symbol parents))))))
(when parents
(widget-insert "
\nParent
groups:
")
(mapcar (lambda (group)
(widget-insert "
")
(widget-create 'link
:tag (custom-unlispify-tag-name group)
:help-echo (format "
\
Create
customize
buffer
for
`
%S
'
group.
" group)
:action (lambda (widget &rest ignore)
(customize-group
(widget-value widget)))
group))
parents)
(widget-insert "
.
\n
"))))
(message "
Creating
customization
magic...
")
(mapcar 'custom-magic-reset custom-options)
(message "
Creating
customization
setup...
")
...
...
@@ -2356,8 +2407,10 @@ Optional EVENT is the location for the menu."
(custom-magic-reset widget))
;;; The `custom-save-all' Function.
(defcustom custom-file "
~/.emacs
"
;;;###autoload
(defcustom custom-file (if (featurep 'xemacs)
"
~/.xemacs-custom
"
"
~/.emacs
")
"
File
used
for
storing
customization
information.
If
you
change
this
from
the
default
\"~/.emacs\"
you
need
to
explicitly
load
that
file
for
the
settings
to
take
effect.
"
...
...
@@ -2481,14 +2534,19 @@ Leave point at the location of the call, or after the last expression."
;;; Menu support
(unless (string-match "
XEmacs
" emacs-version)
(defconst custom-help-menu '("
Customize
"
["
Update
menu...
" custom-menu-update t]
["
Group...
" customize-group t]
["
Variable...
" customize-variable t]
["
Face...
" customize-face t]
["
Saved...
" customize-saved t]
["
Set...
" customize-customized t]
["
Apropos...
" customize-apropos t])
(defconst custom-help-menu
'("
Customize
"
["
Update
menu...
" custom-menu-update t]
["
Group...
" customize-group t]
["
Variable...
" customize-variable t]
["
Face...
" customize-face t]
["
Saved...
" customize-saved t]
["
Set...
" customize-customized t]
["
--
" custom-menu-sep t]
["
Apropos...
" customize-apropos t]
["
Group
apropos...
" customize-apropos-groups t]
["
Variable
apropos...
" customize-apropos-options t]
["
Face
apropos...
" customize-apropos-faces t])
;; This menu should be identical to the one defined in `menu-bar.el'.
"
Customize
menu
")
...
...
lisp/wid-edit.el
View file @
a1a4fa22
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.992
0
;; Version: 1.992
4
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -296,8 +296,11 @@ size field."
(
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
))
(
if
widget-field-add-space
(
add-text-properties
(
1-
to
)
to
'
(
front-sticky
nil
start-open
t
read-only
to
))
(
add-text-properties
to
(
1+
to
)
'
(
front-sticky
nil
start-open
t
read-only
to
)))
(
add-text-properties
(
1-
from
)
from
'
(
rear-nonsticky
t
end-open
t
read-only
from
))
(
let
((
map
(
widget-get
widget
:keymap
))
...
...
@@ -2653,8 +2656,8 @@ link for that string."
(
goto-char
from
)
(
while
(
re-search-forward
regexp
to
t
)
(
let
((
name
(
match-string
1
))
(
begin
(
match-beginning
0
))
(
end
(
match-end
0
)))
(
begin
(
match-beginning
1
))
(
end
(
match-end
1
)))
(
when
(
funcall
predicate
name
)
(
push
(
widget-convert-button
type
begin
end
:value
name
)
buttons
)))))
...
...
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