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
d5c42d02
Commit
d5c42d02
authored
Jun 01, 1997
by
Per Abrahamsen
Browse files
Synched with 1.9903
parent
38d58078
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
51 additions
and
26 deletions
+51
-26
lisp/cus-edit.el
lisp/cus-edit.el
+16
-12
lisp/wid-edit.el
lisp/wid-edit.el
+35
-14
No files found.
lisp/cus-edit.el
View file @
d5c42d02
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; Version: 1.990
1
;; Version: 1.990
3
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -1141,8 +1141,7 @@ If non-nil and not the symbol `long', only show first word."
(insert "
")
(push (widget-create-child-and-convert
widget 'choice-item
:help-echo "
\
Change
the
state
of
this
item.
"
:help-echo "
Change
the
state
of
this
item.
"
:format (if hidden "
%t
" "
%[%t%]
")
:button-prefix 'widget-push-button-prefix
:button-suffix 'widget-push-button-suffix
...
...
@@ -1214,19 +1213,24 @@ Change the state of this item."
(level (widget-get widget :custom-level)))
(cond ((eq escape ?l)
(when level
(insert-char ?\ (1- level))
(if (eq state 'hidden)
(insert-char ?- (* 2 level))
(insert "
/
" (make-string (1- (* 2 level)) ?-)))))
(insert-char ?- (1+ level))
(insert "
/
")
(insert-char ?- 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
")))
(insert "
\n
")
(insert-char ?\ (1- level))
(insert "
\\
")
(insert-char ?- level)
(insert "
" (widget-get widget :tag) "
group
end
")
(insert-char ?- (- 75 (current-column) level))
(insert "
/\n
")))
((eq escape ?-)
(when level
(if (eq state 'hidden)
(insert-char ?- (- 77 (current-column)))
(insert (make-string (- 76 (current-column)) ?-) "
\\
"))))
(when (and level (not (eq state 'hidden)))
(insert-char ?- (- 76 (current-column) level))
(insert "
\\
")))
((eq escape ?L)
(push (widget-create-child-and-convert
widget 'visibility
...
...
lisp/wid-edit.el
View file @
d5c42d02
...
...
@@ -4,7 +4,7 @@
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Version: 1.990
1
;; Version: 1.990
3
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
...
...
@@ -109,6 +109,27 @@ and `end-open' if it should sticky to the front."
(
display-error
obj
buf
)
(
buffer-string
buf
)))))
(
when
(
let
((
a
"foo"
))
(
put-text-property
1
2
'foo
1
a
)
(
put-text-property
1
2
'bar
2
a
)
(
set-text-properties
1
2
nil
a
)
(
text-properties-at
1
a
))
;; XEmacs 20.2 and earlier had a buggy set-text-properties.
(
defun
set-text-properties
(
start
end
props
&optional
buffer-or-string
)
"Completely replace properties of text from START to END.
The third argument PROPS is the new property list.
The optional fourth argument, BUFFER-OR-STRING,
is the string or buffer containing the text."
(
map-extents
#'
(
lambda
(
extent
ignored
)
(
remove-text-properties
start
end
(
list
(
extent-property
extent
'text-prop
)
nil
)
buffer-or-string
)
nil
)
buffer-or-string
start
end
nil
nil
'text-prop
)
(
add-text-properties
start
end
props
buffer-or-string
)))
;;; Customization.
(
defgroup
widgets
nil
...
...
@@ -253,10 +274,16 @@ minibuffer."
(
defun
widget-specify-text
(
from
to
)
;; Default properties.
(
add-text-properties
from
to
(
list
'read-only
t
;; Emacs is sticky.
'front-sticky
t
'start-open
t
'end-open
t
'rear-nonsticky
nil
)))
'rear-nonsticky
nil
;; XEmacs is non-sticky.
'start-open
nil
'end-open
nil
;; This is because `insert'
;; inherit sticky text properties
;; in XEmacs but not in Emacs.
)))
(
defun
widget-specify-field
(
widget
from
to
)
;; Specify editable button for WIDGET between FROM and TO.
...
...
@@ -351,21 +378,18 @@ minibuffer."
'face
face
)))
(
add-text-properties
to
(
1+
to
)
(
list
'local-map
map
'keymap
map
))))
(
defun
widget-specify-button
(
widget
from
to
)
;; Specify button for WIDGET between FROM and TO.
(
let
((
face
(
widget-apply
widget
:button-face-get
))
(
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
(
null
help-echo
)
(
stringp
help-echo
))
(
setq
help-echo
'widget-mouse-help
))
(
add-text-properties
from
to
(
list
'button
widget
'mouse-face
widget-mouse-face
'start-open
t
'end-open
t
help-property
help-echo
'balloon-help
help-echo
'help-echo
help-echo
'face
face
))))
(
defun
widget-mouse-help
(
extent
)
...
...
@@ -1051,7 +1075,7 @@ With optional ARG, move across that many fields."
"Kill to end of field or end of line, whichever is first."
(
interactive
)
(
let
((
field
(
get-text-property
(
point
)
'field
))
(
newline
(
save-excursion
(
search-forward
"\n"
)))
(
newline
(
save-excursion
(
forward-line
1
)))
(
next
(
next-single-property-change
(
point
)
'field
)))
(
if
(
and
field
(
>
newline
next
))
(
kill-region
(
point
)
next
)
...
...
@@ -1661,9 +1685,6 @@ If END is omitted, it defaults to the length of LIST."
(
eq
(
char-after
(
1-
to
))
?\
))
(
setq
to
(
1-
to
)))
(
let
((
result
(
buffer-substring-no-properties
from
to
)))
(
when
(
string-match
"XEmacs"
emacs-version
)
;; XEmacs 20.1 bug: b-s-n-p doesn't clear all properties.
(
setq
result
(
format
"%s"
result
)))
(
when
secret
(
let
((
index
0
))
(
while
(
<
(
+
from
index
)
to
)
...
...
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