Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv12824

Modified Files: entry.lisp Log Message: Changed/added: text widget: new slot eval-text. Defaults to t. If nil then upon setting the model value of the text widget the new valiue will be scanned for "dangerous" characters. These are: [Ê]Ê{Ê} Reason: Tcl evaluates text in brackets as commands. This may be dangerous. If any such dangerous character is found it is replaced by a Space character in order to not change the length of the text.

--- /project/cells/cvsroot/Celtk/entry.lisp 2006/05/24 20:38:54 1.9 +++ /project/cells/cvsroot/Celtk/entry.lisp 2006/05/27 22:28:01 1.10 @@ -68,7 +68,9 @@ (tk-format `(:variable ,self) "set ~a ~s" (^path) new-value))))

(deftk text-widget (widget) - ((modified :initarg :modified :accessor modified :initform nil)) + ((modified :initarg :modified :accessor modified :initform nil) + (eval-text :initarg :eval-text :accessor eval-text :initform (c-in t) + :documentation "Set to nil if you want to make sure text entries do not get evaluated. If set to nil the /dangerous charachters/ will be replaced by space char.")) (:tk-spec text -background -borderwidth -cursor -exportselection (tkfont -font) -foreground @@ -102,8 +104,25 @@ (trc nil "md-value output" self new-value) (with-integrity (:client `(:variable ,self)) (tk-format-now "~a delete 1.0 end" (^path)) - (when (plusp (length new-value)) - (tk-format-now "~a insert end ~s" (^path) new-value)))) + (let ((value nil)) + (when (plusp (length new-value)) + (if (not (^eval-text)) + (setq value (replace-dangerous-chars new-value)) + (setq value new-value)) + (tk-format-now "~a insert end ~s" (^path) value))))) + +;; frgo, 2006-05-27: +;; replace-dangeorous-chars is meant to replace characters in a +;; sequence that would start/end evaluation in Tcl land. +(defun replace-dangerous-chars (seq &optional (dangerous-chars "[]{}")) + (assert (stringp seq)) + (let ((result seq)) + (loop for pos from 0 to (1- (length result)) + do + (let ((c (char result pos))) + (if (find c dangerous-chars) + (setf (char result pos) #\Space)))) + (values result)))

;;;(defvar +tk-keysym-table+ ;;; (let ((ht (make-hash-table :test 'string=))) @@ -116,7 +135,7 @@ ;;; finally (return ht)))))

(defun tk-translate-keysym (keysym$) - (if (= 1 (length keysym$)) + (if (= 1 (length keysym$)) (schar keysym$ 0) (intern (string-upcase keysym$)) #+nah (gethash keysym$ +tk-keysym-table+))) \ No newline at end of file