Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
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
Options
Browse Files
Download
Email Patches
Plain Diff
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