Mercurial > hg > xemacs-beta

comparison lisp/w3/widget-edit.el @ 88:821dec489c24 r20-0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0
author cvs
date Mon, 13 Aug 2007 09:09:59 +0200
parents 364816949b59
children
comparison
equal deleted inserted replaced
87:7df2982f5c17 88:821dec489c24
2 ;; 2 ;;
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: extensions 6 ;; Keywords: extensions
7 ;; Version: 1.20 7 ;; Version: 1.22
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;;; Commentary: 10 ;;; Commentary:
11 ;; 11 ;;
12 ;; See `widget.el'. 12 ;; See `widget.el'.
247 ;; newline. 247 ;; newline.
248 (put-text-property to (1+ to) 'read-only nil)))) 248 (put-text-property to (1+ to) 'read-only nil))))
249 249
250 (defun widget-specify-field-update (widget from to) 250 (defun widget-specify-field-update (widget from to)
251 ;; Specify editable button for WIDGET between FROM and TO. 251 ;; Specify editable button for WIDGET between FROM and TO.
252 (let ((map (or (widget-get widget :keymap) 252 (let ((map (widget-get widget :keymap))
253 widget-keymap)) 253 (secret (widget-get widget :secret))
254 (secret-to to)
255 (size (widget-get widget :size))
254 (face (or (widget-get widget :value-face) 256 (face (or (widget-get widget :value-face)
255 'widget-field-face))) 257 'widget-field-face)))
258
259 (when secret
260 (while (and size
261 (not (zerop size))
262 (> secret-to from)
263 (eq (char-after (1- secret-to)) ?\ ))
264 (setq secret-to (1- secret-to)))
265
266 (save-excursion
267 (goto-char from)
268 (while (< (point) secret-to)
269 (let ((old (get-text-property (point) 'secret)))
270 (when old
271 (subst-char-in-region (point) (1+ (point)) secret old)))
272 (forward-char))))
273
256 (set-text-properties from to (list 'field widget 274 (set-text-properties from to (list 'field widget
257 'read-only nil 275 'read-only nil
258 'keymap map 276 'keymap map
259 'local-map map 277 'local-map map
260 'face face)) 278 'face face))
279
280 (when secret
281 (save-excursion
282 (goto-char from)
283 (while (< (point) secret-to)
284 (let ((old (following-char)))
285 (subst-char-in-region (point) (1+ (point)) old secret)
286 (put-text-property (point) (1+ (point)) 'secret old))
287 (forward-char))))
288
261 (unless (widget-get widget :size) 289 (unless (widget-get widget :size)
262 (add-text-properties to (1+ to) (list 'field widget 290 (add-text-properties to (1+ to) (list 'field widget
263 'face face 291 'face face
264 'local-map map 292 'local-map map
265 'keymap map))))) 293 'keymap map)))))
459 487
460 (defvar widget-keymap nil 488 (defvar widget-keymap nil
461 "Keymap containing useful binding for buffers containing widgets. 489 "Keymap containing useful binding for buffers containing widgets.
462 Recommended as a parent keymap for modes using widgets.") 490 Recommended as a parent keymap for modes using widgets.")
463 491
464 (if widget-keymap 492 (unless widget-keymap
465 ()
466 (setq widget-keymap (make-sparse-keymap)) 493 (setq widget-keymap (make-sparse-keymap))
467 (set-keymap-parent widget-keymap global-map)
468 (define-key widget-keymap "\t" 'widget-forward) 494 (define-key widget-keymap "\t" 'widget-forward)
469 (define-key widget-keymap "\M-\t" 'widget-backward) 495 (define-key widget-keymap "\M-\t" 'widget-backward)
470 (define-key widget-keymap [(shift tab)] 'widget-backward) 496 (define-key widget-keymap [(shift tab)] 'widget-backward)
471 (define-key widget-keymap [(shift tab)] 'widget-backward) 497 (define-key widget-keymap [(shift tab)] 'widget-backward)
472 (define-key widget-keymap [backtab] 'widget-backward) 498 (define-key widget-keymap [backtab] 'widget-backward)
477 (define-key widget-keymap "\C-m" 'widget-button-press)) 503 (define-key widget-keymap "\C-m" 'widget-button-press))
478 504
479 (defvar widget-global-map global-map 505 (defvar widget-global-map global-map
480 "Keymap used for events the widget does not handle themselves.") 506 "Keymap used for events the widget does not handle themselves.")
481 (make-variable-buffer-local 'widget-global-map) 507 (make-variable-buffer-local 'widget-global-map)
508
509 (defvar widget-field-keymap nil
510 "Keymap used inside an editable field.")
511
512 (unless widget-field-keymap
513 (setq widget-field-keymap (copy-keymap widget-keymap))
514 (define-key widget-field-keymap "\C-m" 'widget-field-activate)
515 (set-keymap-parent widget-field-keymap global-map))
516
517 (defvar widget-text-keymap nil
518 "Keymap used inside a text field.")
519
520 (unless widget-text-keymap
521 (setq widget-text-keymap (copy-keymap widget-keymap))
522 (set-keymap-parent widget-text-keymap global-map))
523
524 (defun widget-field-activate (pos &optional event)
525 "Activate the ediable field at point."
526 (interactive "@d")
527 (let* ((field (get-text-property pos 'field)))
528 (if field
529 (widget-apply field :action event)
530 (call-interactively
531 (lookup-key widget-global-map (this-command-keys))))))
482 532
483 (defun widget-button-click (event) 533 (defun widget-button-click (event)
484 "Activate button below mouse pointer." 534 "Activate button below mouse pointer."
485 (interactive "@e") 535 (interactive "@e")
486 (widget-button-press (event-point event) event)) 536 (widget-button-press (event-point event) event))
950 ;;; The `editable-field' Widget. 1000 ;;; The `editable-field' Widget.
951 1001
952 (define-widget 'editable-field 'default 1002 (define-widget 'editable-field 'default
953 "An editable text field." 1003 "An editable text field."
954 :convert-widget 'widget-item-convert-widget 1004 :convert-widget 'widget-item-convert-widget
1005 :keymap widget-field-keymap
955 :format "%v" 1006 :format "%v"
956 :value "" 1007 :value ""
957 :action 'widget-field-action 1008 :action 'widget-field-action
958 :value-create 'widget-field-value-create 1009 :value-create 'widget-field-value-create
959 :value-delete 'widget-field-value-delete 1010 :value-delete 'widget-field-value-delete
1010 (defun widget-field-value-get (widget) 1061 (defun widget-field-value-get (widget)
1011 ;; Return current text in editing field. 1062 ;; Return current text in editing field.
1012 (let ((from (widget-get widget :value-from)) 1063 (let ((from (widget-get widget :value-from))
1013 (to (widget-get widget :value-to)) 1064 (to (widget-get widget :value-to))
1014 (size (widget-get widget :size)) 1065 (size (widget-get widget :size))
1066 (secret (widget-get widget :secret))
1015 (old (current-buffer))) 1067 (old (current-buffer)))
1016 (if (and from to) 1068 (if (and from to)
1017 (progn 1069 (progn
1018 (set-buffer (marker-buffer from)) 1070 (set-buffer (marker-buffer from))
1019 (setq from (1+ from) 1071 (setq from (1+ from)
1021 (while (and size 1073 (while (and size
1022 (not (zerop size)) 1074 (not (zerop size))
1023 (> to from) 1075 (> to from)
1024 (eq (char-after (1- to)) ?\ )) 1076 (eq (char-after (1- to)) ?\ ))
1025 (setq to (1- to))) 1077 (setq to (1- to)))
1026 (prog1 (buffer-substring-no-properties from to) 1078 (let ((result (buffer-substring-no-properties from to)))
1027 (set-buffer old))) 1079 (when secret
1080 (let ((index 0))
1081 (while (< (+ from index) to)
1082 (aset result index
1083 (get-text-property (+ from index) 'secret))
1084 (setq index (1+ index)))))
1085 (set-buffer old)
1086 result))
1028 (widget-get widget :value)))) 1087 (widget-get widget :value))))
1029 1088
1030 (defun widget-field-match (widget value) 1089 (defun widget-field-match (widget value)
1031 ;; Match any string. 1090 ;; Match any string.
1032 (stringp value)) 1091 (stringp value))
1033 1092
1034 ;;; The `text' Widget. 1093 ;;; The `text' Widget.
1035 1094
1036 (define-widget 'text 'editable-field 1095 (define-widget 'text 'editable-field
1096 :keymap widget-text-keymap
1037 "A multiline text area.") 1097 "A multiline text area.")
1038 1098
1039 ;;; The `menu-choice' Widget. 1099 ;;; The `menu-choice' Widget.
1040 1100
1041 (define-widget 'menu-choice 'default 1101 (define-widget 'menu-choice 'default