aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2000-10-25 07:16:44 +0000
committerMiles Bader2000-10-25 07:16:44 +0000
commita850ac03f0ee327daa76d6ce27c8b4b20d5f38cc (patch)
treed42f9e80d7723352e314c0b22494aebd292eac48
parentebe2a441bf738ec10c527bfdf04d0838fa0152e5 (diff)
downloademacs-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.el72
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.
905POS defaults to the value of (point)." 920POS 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))