CLIM mail archive
[Prev][Next][Index][Thread]

More on highlighting

   Date: 09 Nov 1992 17:43:25 -0600 (CST)
   From: Randy Coulman <coulman%skdad.usask.ca@lucid.com>
   X-Envelope-To: clim@bbn.com
   Content-Transfer-Encoding: 7BIT
   X-Mailer: ELM [version 2.3 PL11]

   I am currently trying to build a simple example of something I need for the
   system I'm building.  This simple example involves parsing a paragraph of
   text, but not in the natural language sense.  I accept a string from the
   user and break it into sentences, then clauses, then words.  I end up with
   a 4-deep tree representing the paragraph - the root is the paragraph, with
   each child being a sentence, each grandchild a clause and each
   great-grandchild a word.  Each node in the tree is called a context, and
   the tree itself a context-tree.  Each context contains a "data-item"
   object, and the start and end position of the data in the original string.
   I have defined presentation methods for both contexts and data-items.  A
   leaf context is presented by presenting it's data-item with :sensitive nil.
   The presentation method for data-item simply uses format to output the
   string.  There is a reason for this level of indirection, but it's not
   really important here.  A non-leaf context is presented by presenting child
   contexts separated by any filler that was in the original string (which
   includes spaces, punctutation and newlines.

   Next, I want the user to be able to select any context (whose corresponding
   string is then bolded and some information about the context is displayed).

   Using my adapted version of Chee, leaf contexts highlight properly.  But,
   if I move the mouse cursor over a "filler" character, only the filler
   characters of the corresponding non-leaf context are highlighted. 

Here is a simple implementation of nested contexts.  It just does
simple box-style highlighting (no bold text), but other than that
does it give you the kind of sensitivity that you want?

Compile and load this, then run the function TEST on an existing CLIM
stream window.

================================================================
(in-package :clim-user)

(defclass context ()
  ((string :accessor context-string)
   (start :accessor context-start)
   (end :accessor context-end)
   (children :accessor context-children :initform nil)))

(defclass word (context)
  ())

(defclass sentence (context)
  ())

(defclass paragraph (context)
  ())

(define-presentation-type context ())

(define-presentation-method present (object (type context) stream (view textual-view)
					    &key)
  (write-string (context-string object) stream 
		:start (context-start object) :end (context-end object)))

(define-presentation-type word ())

(define-presentation-type sentence ())

(define-presentation-method present (object (type sentence) stream (view textual-view)
					    &key)
  (dolist (child (context-children object))
    (present child (class-of child) :stream stream)))

;;; To get the PRESENT method
(define-presentation-type paragraph ()
  :inherit-from 'sentence)

(defun make-context (type string start end)
  (let ((context (make-instance type)))
    (setf (context-string context) string)
    (setf (context-start context) start)
    (setf (context-end context) end)
    context))

(defvar *the-string* "This is sentence one.  This is sentence two.")

(defvar *contexts* nil)

(defun build-structure ()
  (let ((p1 (make-context 'paragraph *the-string* 0 (length *the-string*)))
	(s1 (make-context 'sentence *the-string* 0 21))
	(s2 (make-context 'sentence *the-string* 23 44))
	(w1 (list
	      (make-context 'word *the-string* 0 4)
	      (make-context 'context *the-string* 4 5)
	      (make-context 'word *the-string* 5 7)
	      (make-context 'context *the-string* 7 8)
	      (make-context 'word *the-string* 8 16)
	      (make-context 'context *the-string* 16 17)
	      (make-context 'word *the-string* 17 20)))
	(w2 (list
	      (make-context 'word *the-string* 23 27)
	      (make-context 'context *the-string* 27 28)
	      (make-context 'word *the-string* 28 30)
	      (make-context 'context *the-string* 30 31)
	      (make-context 'word *the-string* 31 39)
	      (make-context 'context *the-string* 39 40)
	      (make-context 'word *the-string* 40 43))))
    (setf (context-children p1) 
	  (list s1
		(make-context 'context *the-string* 20 23)
		s2))
    (setf (context-children s1) w1)
    (setf (context-children s2) w2)
    (setq *contexts* (list p1))))

(defun show-contexts (stream)
  (window-clear stream)
  (dolist (context *contexts*)
    (present context (class-of context) :stream stream))
  (force-output stream))

(defun test (stream)
  (build-structure)
  (show-contexts stream)
  (fresh-line stream)
  (accept '(or paragraph sentence word) :stream stream))


0,,
References:
Main Index | Thread Index