diff options
| author | Miles Bader | 2000-10-25 07:16:44 +0000 |
|---|---|---|
| committer | Miles Bader | 2000-10-25 07:16:44 +0000 |
| commit | a850ac03f0ee327daa76d6ce27c8b4b20d5f38cc (patch) | |
| tree | d42f9e80d7723352e314c0b22494aebd292eac48 | |
| parent | ebe2a441bf738ec10c527bfdf04d0838fa0152e5 (diff) | |
| download | emacs-a850ac03f0ee327daa76d6ce27c8b4b20d5f38cc.tar.gz emacs-a850ac03f0ee327daa76d6ce27c8b4b20d5f38cc.zip | |
(widget-field-at): New function.
(widget-at, widget-field-activate): Use it.
(widget-tabable-at): Use `widget-at'.
(widget-specify-field): If the terminating character of the widget
field (which is read-only) is a newline, put it into a special
`boundary' field so that C-n/C-p act more naturally.
(widget-field-end): Also don't subtract one if a special
`boundary' field has been added after the widget field.
| -rw-r--r-- | lisp/wid-edit.el | 72 |
1 files changed, 47 insertions, 25 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 0196ee0b469..f81751e801c 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -318,16 +318,31 @@ new value.") | |||
| 318 | (widget-field-add-space | 318 | (widget-field-add-space |
| 319 | (insert-and-inherit " "))) | 319 | (insert-and-inherit " "))) |
| 320 | (setq to (point))) | 320 | (setq to (point))) |
| 321 | (let ((overlay (make-overlay from to nil | 321 | (let ((keymap (widget-get widget :keymap)) |
| 322 | nil (or (not widget-field-add-space) | 322 | (face (or (widget-get widget :value-face) 'widget-field-face)) |
| 323 | (widget-get widget :size))))) | 323 | (help-echo (widget-get widget :help-echo)) |
| 324 | (widget-put widget :field-overlay overlay) | 324 | (rear-sticky |
| 325 | ;;(overlay-put overlay 'detachable nil) | 325 | (or (not widget-field-add-space) (widget-get widget :size)))) |
| 326 | (overlay-put overlay 'field widget) | 326 | (when (= (char-before to) ?\n) |
| 327 | (overlay-put overlay 'keymap (widget-get widget :keymap)) | 327 | ;; When the last character in the field is a newline, we want to |
| 328 | (overlay-put overlay 'face (or (widget-get widget :value-face) | 328 | ;; give it a `field' char-property of `boundary', which helps the |
| 329 | 'widget-field-face)) | 329 | ;; C-n/C-p act more naturally when entering/leaving the field. We |
| 330 | (overlay-put overlay 'help-echo (widget-get widget :help-echo))) | 330 | ;; do this by making a small secondary overlay to contain just that |
| 331 | ;; one character. | ||
| 332 | (let ((overlay (make-overlay (1- to) to nil t nil))) | ||
| 333 | (overlay-put overlay 'field 'boundary) | ||
| 334 | (overlay-put overlay 'keymap keymap) | ||
| 335 | (overlay-put overlay 'face face) | ||
| 336 | (overlay-put overlay 'help-echo help-echo)) | ||
| 337 | (setq to (1- to)) | ||
| 338 | (setq rear-sticky t)) | ||
| 339 | (let ((overlay (make-overlay from to nil nil rear-sticky))) | ||
| 340 | (widget-put widget :field-overlay overlay) | ||
| 341 | ;;(overlay-put overlay 'detachable nil) | ||
| 342 | (overlay-put overlay 'field widget) | ||
| 343 | (overlay-put overlay 'keymap keymap) | ||
| 344 | (overlay-put overlay 'face face) | ||
| 345 | (overlay-put overlay 'help-echo help-echo))) | ||
| 331 | (widget-specify-secret widget)) | 346 | (widget-specify-secret widget)) |
| 332 | 347 | ||
| 333 | (defun widget-specify-secret (field) | 348 | (defun widget-specify-secret (field) |
| @@ -808,7 +823,7 @@ Recommended as a parent keymap for modes using widgets.") | |||
| 808 | (defun widget-field-activate (pos &optional event) | 823 | (defun widget-field-activate (pos &optional event) |
| 809 | "Invoke the ediable field at point." | 824 | "Invoke the ediable field at point." |
| 810 | (interactive "@d") | 825 | (interactive "@d") |
| 811 | (let ((field (get-char-property pos 'field))) | 826 | (let ((field (widget-field-at pos))) |
| 812 | (if field | 827 | (if field |
| 813 | (widget-apply-action field event) | 828 | (widget-apply-action field event) |
| 814 | (call-interactively | 829 | (call-interactively |
| @@ -903,10 +918,7 @@ Recommended as a parent keymap for modes using widgets.") | |||
| 903 | (defun widget-tabable-at (&optional pos) | 918 | (defun widget-tabable-at (&optional pos) |
| 904 | "Return the tabable widget at POS, or nil. | 919 | "Return the tabable widget at POS, or nil. |
| 905 | POS defaults to the value of (point)." | 920 | POS defaults to the value of (point)." |
| 906 | (unless pos | 921 | (let ((widget (widget-at pos))) |
| 907 | (setq pos (point))) | ||
| 908 | (let ((widget (or (get-char-property pos 'button) | ||
| 909 | (get-char-property pos 'field)))) | ||
| 910 | (if widget | 922 | (if widget |
| 911 | (let ((order (widget-get widget :tab-order))) | 923 | (let ((order (widget-get widget :tab-order))) |
| 912 | (if order | 924 | (if order |
| @@ -1017,6 +1029,11 @@ When not inside a field, move to the previous button or field." | |||
| 1017 | ;; List of all editable fields in the buffer. | 1029 | ;; List of all editable fields in the buffer. |
| 1018 | (make-variable-buffer-local 'widget-field-list) | 1030 | (make-variable-buffer-local 'widget-field-list) |
| 1019 | 1031 | ||
| 1032 | (defun widget-at (&optional pos) | ||
| 1033 | "The button or field at POS (default, point)." | ||
| 1034 | (or (get-char-property (or pos (point)) 'button) | ||
| 1035 | (widget-field-at pos))) | ||
| 1036 | |||
| 1020 | (defun widget-setup () | 1037 | (defun widget-setup () |
| 1021 | "Setup current buffer so editing string widgets works." | 1038 | "Setup current buffer so editing string widgets works." |
| 1022 | (let ((inhibit-read-only t) | 1039 | (let ((inhibit-read-only t) |
| @@ -1043,6 +1060,13 @@ When not inside a field, move to the previous button or field." | |||
| 1043 | ;; The widget data before the change. | 1060 | ;; The widget data before the change. |
| 1044 | (make-variable-buffer-local 'widget-field-was) | 1061 | (make-variable-buffer-local 'widget-field-was) |
| 1045 | 1062 | ||
| 1063 | (defun widget-field-at (pos) | ||
| 1064 | "Return the widget field at POS, or nil if none." | ||
| 1065 | (let ((field (get-char-property (or pos (point)) 'field))) | ||
| 1066 | (if (eq field 'boundary) | ||
| 1067 | nil | ||
| 1068 | field))) | ||
| 1069 | |||
| 1046 | (defun widget-field-buffer (widget) | 1070 | (defun widget-field-buffer (widget) |
| 1047 | "Return the start of WIDGET's editing field." | 1071 | "Return the start of WIDGET's editing field." |
| 1048 | (let ((overlay (widget-get widget :field-overlay))) | 1072 | (let ((overlay (widget-get widget :field-overlay))) |
| @@ -1056,9 +1080,14 @@ When not inside a field, move to the previous button or field." | |||
| 1056 | (defun widget-field-end (widget) | 1080 | (defun widget-field-end (widget) |
| 1057 | "Return the end of WIDGET's editing field." | 1081 | "Return the end of WIDGET's editing field." |
| 1058 | (let ((overlay (widget-get widget :field-overlay))) | 1082 | (let ((overlay (widget-get widget :field-overlay))) |
| 1059 | ;; Don't subtract one if local-map works at the end of the overlay. | 1083 | ;; Don't subtract one if local-map works at the end of the overlay, |
| 1060 | (and overlay (if (or widget-field-add-space | 1084 | ;; or if a special `boundary' field has been added after the widget |
| 1061 | (null (widget-get widget :size))) | 1085 | ;; field. |
| 1086 | (and overlay (if (and (not (eq (get-char-property (overlay-end overlay) | ||
| 1087 | 'field) | ||
| 1088 | 'boundary)) | ||
| 1089 | (or widget-field-add-space | ||
| 1090 | (null (widget-get widget :size)))) | ||
| 1062 | (1- (overlay-end overlay)) | 1091 | (1- (overlay-end overlay)) |
| 1063 | (overlay-end overlay))))) | 1092 | (overlay-end overlay))))) |
| 1064 | 1093 | ||
| @@ -3351,13 +3380,6 @@ To use this type, you must define :match or :match-alternatives." | |||
| 3351 | 3380 | ||
| 3352 | ;;; The Help Echo | 3381 | ;;; The Help Echo |
| 3353 | 3382 | ||
| 3354 | (defun widget-at (&optional pos) | ||
| 3355 | "The button or field at POS (default, point)." | ||
| 3356 | (unless pos | ||
| 3357 | (setq pos (point))) | ||
| 3358 | (or (get-char-property pos 'button) | ||
| 3359 | (get-char-property pos 'field))) | ||
| 3360 | |||
| 3361 | (defun widget-echo-help (pos) | 3383 | (defun widget-echo-help (pos) |
| 3362 | "Display the help echo for widget at POS." | 3384 | "Display the help echo for widget at POS." |
| 3363 | (let* ((widget (widget-at pos)) | 3385 | (let* ((widget (widget-at pos)) |