Mercurial > hg > xemacs-beta

comparison lisp/w3/widget-edit.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 9ee227acff29
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
41 ;; These should be specified with the custom package. 41 ;; These should be specified with the custom package.
42 42
43 (defvar widget-button-face 'bold) 43 (defvar widget-button-face 'bold)
44 (defvar widget-mouse-face 'highlight) 44 (defvar widget-mouse-face 'highlight)
45 (defvar widget-field-face 'italic) 45 (defvar widget-field-face 'italic)
46
47 (defvar widget-motion-hook nil
48 "*Hook to be run after widget traversal (via `widget-forward|backward').
49 The hooks will all be called with on argument - the widget that was just
50 selected.")
46 51
47 ;;; Utility functions. 52 ;;; Utility functions.
48 ;; 53 ;;
49 ;; These are not really widget specific. 54 ;; These are not really widget specific.
50 55
123 (put-text-property from to 'widget-doc widget)) 128 (put-text-property from to 'widget-doc widget))
124 129
125 130
126 (defmacro widget-specify-insert (&rest form) 131 (defmacro widget-specify-insert (&rest form)
127 ;; Execute FORM without inheriting any text properties. 132 ;; Execute FORM without inheriting any text properties.
128 `(save-restriction 133 (`
134 (save-restriction
129 (let ((inhibit-read-only t) 135 (let ((inhibit-read-only t)
130 result 136 result
131 after-change-functions) 137 after-change-functions)
132 (insert "<>") 138 (insert "<>")
133 (narrow-to-region (- (point) 2) (point)) 139 (narrow-to-region (- (point) 2) (point))
134 (widget-specify-none (point-min) (point-max)) 140 (widget-specify-none (point-min) (point-max))
135 (goto-char (1+ (point-min))) 141 (goto-char (1+ (point-min)))
136 (setq result (progn ,@form)) 142 (setq result (progn (,@ form)))
137 (delete-region (point-min) (1+ (point-min))) 143 (delete-region (point-min) (1+ (point-min)))
138 (delete-region (1- (point-max)) (point-max)) 144 (delete-region (1- (point-max)) (point-max))
139 (goto-char (point-max)) 145 (goto-char (point-max))
140 result))) 146 result))))
141 147
142 ;;; Widget Properties. 148 ;;; Widget Properties.
143 149
144 (defun widget-put (widget property value) 150 (defun widget-put (widget property value)
145 "In WIDGET set PROPERTY to VALUE. 151 "In WIDGET set PROPERTY to VALUE.
348 (field (previous-single-property-change (point) 'field))) 354 (field (previous-single-property-change (point) 'field)))
349 (cond ((and button field) 355 (cond ((and button field)
350 (goto-char (max button field))) 356 (goto-char (max button field)))
351 (button (goto-char button)) 357 (button (goto-char button))
352 (field (goto-char field))))) 358 (field (goto-char field)))))
353 (let ((help-echo (or (get-text-property (point) 'button) 359 (run-hook-with-args 'widget-motion-hook (or
354 (get-text-property (point) 'field)))) 360 (get-text-property (point) 'button)
355 (if (and help-echo (setq help-echo (widget-get help-echo :help-echo))) 361 (get-text-property (point) 'field)))
356 (message "%s" help-echo)))) 362 )
357 363
358 (defun widget-backward (arg) 364 (defun widget-backward (arg)
359 "Move point to the previous field or button. 365 "Move point to the previous field or button.
360 With optional ARG, move across that many fields." 366 With optional ARG, move across that many fields."
361 (interactive "p") 367 (interactive "p")