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

Import from CVS: tag r20-0
author cvs
date Mon, 13 Aug 2007 09:09:59 +0200
parents 364816949b59
children
line wrap: on
line diff
--- a/lisp/w3/widget-edit.el	Mon Aug 13 09:09:05 2007 +0200
+++ b/lisp/w3/widget-edit.el	Mon Aug 13 09:09:59 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.20
+;; Version: 1.22
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -249,15 +249,43 @@
 
 (defun widget-specify-field-update (widget from to)
   ;; Specify editable button for WIDGET between FROM and TO.
-  (let ((map (or (widget-get widget :keymap)
-		 widget-keymap))
+  (let ((map (widget-get widget :keymap))
+	(secret (widget-get widget :secret))
+	(secret-to to)
+	(size (widget-get widget :size))
 	(face (or (widget-get widget :value-face)
 		  'widget-field-face)))
+
+    (when secret 
+      (while (and size
+		  (not (zerop size))
+		  (> secret-to from)
+		  (eq (char-after (1- secret-to)) ?\ ))
+	(setq secret-to (1- secret-to)))
+
+      (save-excursion
+	(goto-char from)
+	(while (< (point) secret-to)
+	  (let ((old (get-text-property (point) 'secret)))
+	    (when old
+	      (subst-char-in-region (point) (1+ (point)) secret old)))
+	  (forward-char))))
+
     (set-text-properties from to (list 'field widget
 				       'read-only nil
 				       'keymap map
 				       'local-map map
 				       'face face))
+
+    (when secret 
+      (save-excursion
+	(goto-char from)
+	(while (< (point) secret-to)
+	  (let ((old (following-char)))
+	    (subst-char-in-region (point) (1+ (point)) old secret)
+	    (put-text-property (point) (1+ (point)) 'secret old))
+	  (forward-char))))
+
     (unless (widget-get widget :size)
       (add-text-properties to (1+ to) (list 'field widget
 					    'face face
@@ -461,10 +489,8 @@
   "Keymap containing useful binding for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")
 
-(if widget-keymap 
-    ()
+(unless widget-keymap 
   (setq widget-keymap (make-sparse-keymap))
-  (set-keymap-parent widget-keymap global-map)
   (define-key widget-keymap "\t" 'widget-forward)
   (define-key widget-keymap "\M-\t" 'widget-backward)
   (define-key widget-keymap [(shift tab)] 'widget-backward)
@@ -480,6 +506,30 @@
   "Keymap used for events the widget does not handle themselves.")
 (make-variable-buffer-local 'widget-global-map)
 
+(defvar widget-field-keymap nil
+  "Keymap used inside an editable field.")
+
+(unless widget-field-keymap 
+  (setq widget-field-keymap (copy-keymap widget-keymap))
+  (define-key widget-field-keymap "\C-m" 'widget-field-activate)
+  (set-keymap-parent widget-field-keymap global-map))
+
+(defvar widget-text-keymap nil
+  "Keymap used inside a text field.")
+
+(unless widget-text-keymap 
+  (setq widget-text-keymap (copy-keymap widget-keymap))
+  (set-keymap-parent widget-text-keymap global-map))
+
+(defun widget-field-activate (pos &optional event)
+  "Activate the ediable field at point."
+  (interactive "@d")
+  (let* ((field (get-text-property pos 'field)))
+    (if field
+	(widget-apply field :action event)
+      (call-interactively
+       (lookup-key widget-global-map (this-command-keys))))))
+
 (defun widget-button-click (event)
   "Activate button below mouse pointer."
   (interactive "@e")
@@ -952,6 +1002,7 @@
 (define-widget 'editable-field 'default
   "An editable text field."
   :convert-widget 'widget-item-convert-widget
+  :keymap widget-field-keymap
   :format "%v"
   :value ""
   :action 'widget-field-action
@@ -1012,6 +1063,7 @@
   (let ((from (widget-get widget :value-from))
 	(to (widget-get widget :value-to))
 	(size (widget-get widget :size))
+	(secret (widget-get widget :secret))
 	(old (current-buffer)))
     (if (and from to)
 	(progn 
@@ -1023,8 +1075,15 @@
 		      (> to from)
 		      (eq (char-after (1- to)) ?\ ))
 	    (setq to (1- to)))
-	  (prog1 (buffer-substring-no-properties from to)
-	    (set-buffer old)))
+	  (let ((result (buffer-substring-no-properties from to)))
+	    (when secret
+	      (let ((index 0))
+		(while (< (+ from index) to)
+		  (aset result index
+			(get-text-property (+ from index) 'secret))
+		  (setq index (1+ index)))))
+	    (set-buffer old)
+	    result))
       (widget-get widget :value))))
 
 (defun widget-field-match (widget value)
@@ -1034,6 +1093,7 @@
 ;;; The `text' Widget.
 
 (define-widget 'text 'editable-field
+  :keymap widget-text-keymap
   "A multiline text area.")
 
 ;;; The `menu-choice' Widget.