Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 290:c9fe270a4101 r21-0b43

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b43
author cvs
date Mon, 13 Aug 2007 10:36:47 +0200
parents 7df0dd720c89
children d1b52dcaa789
comparison
equal deleted inserted replaced
289:6e6992ccc4b6 290:c9fe270a4101
336 (set-extent-property extent 'detachable nil) 336 (set-extent-property extent 'detachable nil)
337 (set-extent-property extent 'field widget) 337 (set-extent-property extent 'field widget)
338 (set-extent-property extent 'button-or-field t) 338 (set-extent-property extent 'button-or-field t)
339 (set-extent-property extent 'keymap map) 339 (set-extent-property extent 'keymap map)
340 (set-extent-property extent 'face face) 340 (set-extent-property extent 'face face)
341 (widget-handle-help-echo extent help-echo))) 341 (widget-handle-help-echo extent help-echo))
342 (widget-specify-secret widget))
343
344 (defun widget-specify-secret (field)
345 "Replace text in FIELD with value of `:secret', if non-nil."
346 (let ((secret (widget-get field :secret))
347 (size (widget-get field :size)))
348 (when secret
349 (let ((begin (widget-field-start field))
350 (end (widget-field-end field)))
351 (when size
352 (while (and (> end begin)
353 (eq (char-after (1- end)) ?\ ))
354 (setq end (1- end))))
355 (while (< begin end)
356 (let ((old (char-after begin)))
357 (unless (eq old secret)
358 (subst-char-in-region begin (1+ begin) old secret)
359 (put-text-property begin (1+ begin) 'secret old))
360 (setq begin (1+ begin))))))))
342 361
343 (defun widget-specify-button (widget from to) 362 (defun widget-specify-button (widget from to)
344 "Specify button for WIDGET between FROM and TO." 363 "Specify button for WIDGET between FROM and TO."
345 (let ((face (widget-apply widget :button-face-get)) 364 (let ((face (widget-apply widget :button-face-get))
346 (help-echo (widget-get widget :help-echo)) 365 (help-echo (widget-get widget :help-echo))
1479 (let ((field (widget-field-find from)) 1498 (let ((field (widget-field-find from))
1480 (other (widget-field-find to))) 1499 (other (widget-field-find to)))
1481 (when field 1500 (when field
1482 (unless (eq field other) 1501 (unless (eq field other)
1483 (debug "Change in different fields")) 1502 (debug "Change in different fields"))
1484 (let ((size (widget-get field :size)) 1503 (let ((size (widget-get field :size)))
1485 (secret (widget-get field :secret)))
1486 (when size 1504 (when size
1487 (let ((begin (widget-field-start field)) 1505 (let ((begin (widget-field-start field))
1488 (end (widget-field-end field))) 1506 (end (widget-field-end field)))
1489 (cond ((< (- end begin) size) 1507 (cond ((< (- end begin) size)
1490 ;; Field too small. 1508 ;; Field too small.
1502 (save-excursion 1520 (save-excursion
1503 (goto-char end) 1521 (goto-char end)
1504 (while (and (eq (preceding-char) ?\ ) 1522 (while (and (eq (preceding-char) ?\ )
1505 (> (point) begin)) 1523 (> (point) begin))
1506 (delete-backward-char 1))))))) 1524 (delete-backward-char 1)))))))
1507 (when secret 1525 (widget-specify-secret field))
1508 (let ((begin (widget-field-start field))
1509 (end (widget-field-end field)))
1510 (when size
1511 (while (and (> end begin)
1512 (eq (char-after (1- end)) ?\ ))
1513 (setq end (1- end))))
1514 (while (< begin end)
1515 (let ((old (char-after begin)))
1516 (unless (eq old secret)
1517 (subst-char-in-region begin (1+ begin) old secret)
1518 (put-text-property begin (1+ begin) 'secret old))
1519 (incf begin))))))
1520 (widget-apply field :notify field))) 1526 (widget-apply field :notify field)))
1521 (error (debug "After Change")))) 1527 (error (debug "After Change"))))
1522 1528
1523 1529
1524 ;;; Widget Functions 1530 ;;; Widget Functions