[ltk-user] text widget, tk8.5

Jan Rychter jan at rychter.com
Mon Sep 18 16:37:53 UTC 2006


Well. So I went ahead and implemented all the tag commands except for
cget and ranges, fixing a minor thing in the process:

(defun tag-to-string (tag)
  "Convert a lisp-side tag to a string, return the resulting string"
  (if (stringp tag)
      tag
      (if tag
	  (format nil "~(~a~)" tag)
	  "")))

(defgeneric tag-add (txt tag &rest indices))
(defmethod tag-add ((txt text) tag &rest indices)
  (format-wish "~a tag add ~a ~{ ~(~a~)~}"
	       (widget-path txt)
	       (tag-to-string tag)
	       indices)
  txt)

(defgeneric tag-remove (txt tag &rest indices))
(defmethod tag-remove ((txt text) tag &rest indices)
  (format-wish "~a tag remove ~a ~{ ~(~a~)~}"
	       (widget-path txt)
	       (tag-to-string tag)
	       indices)
  txt)

(defgeneric tag-configure (txt tag option value))
(defmethod tag-configure ((txt text) tag option value)
  (format-wish "~a tag configure ~a -~(~a~) {~(~a~)}" (widget-path txt)
	       (tag-to-string tag)
	       option value)
  txt)

(defgeneric tag-bind (txt tag event fun))
(defmethod tag-bind ((txt text) tag event fun)
  "bind fun to event of the tag of the text widget txt"
  (let ((name (create-name)))
    (add-callback name fun)
    (format-wish "~a tag bind ~(~a~) ~a {callback ~A}"
		 (widget-path txt) (tag-to-string tag)
		 event name))
  txt)

(defgeneric tag-delete (txt tag &rest other-tags))
(defmethod tag-delete ((txt text) tag &rest other-tags)
  (format-wish "~a tag delete ~a ~{ ~(~a~)~}"
	       (widget-path txt)
	       (tag-to-string tag)
	       (mapcar #'tag-to-string other-tags))
  txt)

(defgeneric tag-lower (txt tag &optional other-tag))
(defmethod tag-lower ((txt text) tag &optional other-tag)
  (format-wish "~a tag lower ~a ~a"
	       (widget-path txt)
	       (tag-to-string tag)
	       (tag-to-string other-tag))
  txt)

(defgeneric tag-raise (txt tag &optional other-tag))
(defmethod tag-raise ((txt text) tag &optional other-tag)
  (format-wish "~a tag raise ~a ~a"
	       (widget-path txt)
	       (tag-to-string tag)
	       (tag-to-string other-tag))
  txt)

(defgeneric tag-names (txt index))
(defmethod tag-names ((txt text) index)
  (format-wish "~a tag names ~(~a~)"
	       (widget-path txt)
	       index)
  txt)

(defgeneric tag-nextrange (txt tag index1 &optional index2))
(defmethod tag-nextrange ((txt text) tag index1 &optional index2)
  (format-wish "~a tag nextrange ~a ~(~a~) ~(~a~)"
	       (widget-path txt)
	       (tag-to-string tag)
	       index1
	       (if index2 index2 ""))
  txt)

(defgeneric tag-prevrange (txt tag index1 &optional index2))
(defmethod tag-prevrange ((txt text) tag index1 &optional index2)
  (format-wish "~a tag nextrange ~a ~(~a~) ~(~a~)"
	       (widget-path txt)
	       (tag-to-string tag)
	       index1
	       (if index2 index2 ""))
  txt)

(defgeneric tag-ranges (txt tag))
(defmethod tag-ranges ((txt text) tag)
  (format-wish "~a tag ranges ~a" (widget-path txt) (tag-to-string tag))
  (read-data))

Now, both cget and ranges need to read data from wish -- how do I do
that? It seems that read-data will break if there is no data to read,
and "tag ranges" may or may not return data.

--J.



More information about the ltk-user mailing list