🚀 go-pugleaf

I am doing some software development on KEE (Knowledge
Engineering Environment, IntelliCorp). I tried to 
display a large file using Common-Window with extent
scrolling feature and  each token (word) is represented as a hostspot.
Users may use mouse to pick up any token  and to click a mouse button
to activate an action. It worked OK. However the scrolling
is extremely slow. I knew that I must did something stupid.

Related code is enclosed. Can any one out there give me some help?
Thanks in advance,

PS: Please forward this message to whomever  who may help me out.
 
--------cut-------cut-------cut------------

;;  -*- Mode: LISP; Syntax:Common-lisp; Package:KEE; Base:10. -*-
(defvar ww nil)  ;; working window

(defvar *working-file-name* nil)
(defvar *active-hs* nil)

(defun make-fop-window ()
  (setq ww (make-window-stream :left 10
	  		     :bottom 10
		  	     :width  1100
			       :height  800
  			     :inner-left 10
	  		     :inner-bottom 10
		  	     :activate-p t
			       :title  "FOP Parsing Table Generator"
			     :parent *kee-root-window*
  			     :font-set (list (open-font 'fixed-width
  							'plain
	   						'medium))))
)

(defvar *script-file* nil)
(defvar *text* nil)

(defun initialize-everything (file-name)
  (setq *text* nil)
  (setq *text* (revert-buffer-file file-name))
)


(defun fop (&optional (file-name "c.dat") (script-file "script.lisp"))
  (setq *script-file* script-file)
  (setq *working-file-name* file-name)
  (make-fop-window)
  (initialize-everything file-name)
   (enable-window-stream-extent-scrolling ww)
   (setf (window-stream-extent-height ww) 3000)
   (setf (window-stream-repaint ww) 'test-repaint)
   (setf (window-stream-button ww) 'button-fn)
   (setf (window-stream-y-offset ww) 2250)
   (repaint ww)
   )

(defun test-repaint (window region)
  (setf (window-stream-hotspot-list window) nil)
  (bitblt window
	  (window-stream-x-offset window)
	  (window-stream-y-offset window)
	  window
	  (window-stream-x-offset window)
	  (window-stream-y-offset window)
	  (window-stream-inner-width window)
	  (window-stream-inner-height window)
	  boole-clr)
  (setf (window-stream-x-position window) 0)
  (setf (window-stream-y-position window) (- (window-stream-extent-height window)
					     (window-stream-ascent window)))

  (write-title ww (concat "FOP working buffer       " 
			  " ---------- "
			  *working-file-name*))
  (setq khn *text*)
  (do (tmp line line-id word-id (seg-id 1)) ((null khn))
      (if (< (nth 0 (car khn)) 0)
	  (progn
	    (format ww "~2D --: " seg-id)
	    (setq seg-id (1+ seg-id)))
	(format ww "~5D: " (nth 0 (car khn))))
      (setq line-id (nth 0 (car khn)))
      (setq line (nth 1 (car khn)))
      (setq word-id 0)
      (setq tmp (break-line line))
      (do (str ) ((null tmp))
	  (setq str (car tmp))
	  (if (eq '#\space (char str 0))
	      (format ww str)
	    (progn
	      (generate-hotspot
		(window-stream-x-position window)
		(window-stream-y-position window)
		str line-id word-id  window)
	      (setq word-id (1+ word-id))))
	  (setq tmp (cdr tmp)))
      (terpri  window)
      (setq khn (cdr khn)))
  )

(defstruct HOTSPOT region)
(defstruct (MY-HOTSPOT
	     (:include hotspot))
           menu-to-pop-up
           yes-no-menu
           line-id word-id
	   function-to-call)

(defun generate-hotspot (x y text line-id word-id window
			   &optional
			   (function-to-call 'default-fn)
			   (menu insert-mark-menu)
                           (y-or-n-menu yes-or-no-menu))
  (let* ((old-hs (window-stream-hotspot-list window))
	 (hs (make-my-hotspot))
	 (font (window-stream-font window))
	 (width (font-string-width font text))
	 (height (font-character-height font)))
    (setf (window-stream-x-position window) x)
    (setf (window-stream-y-position window) y)
    (format window text)
    (setf (my-hotspot-region hs)
	  (make-region :left x
		       :bottom (- y (window-stream-baseline window))
		       :width width :height height))
    (setf (my-hotspot-function-to-call hs) function-to-call)
    (setf (my-hotspot-menu-to-pop-up hs) menu)
    (setf (my-hotspot-line-id hs) line-id)
    (setf (my-hotspot-word-id hs) word-id)
    (setf (my-hotspot-yes-no-menu hs) y-or-n-menu)
    (setf (window-stream-hotspot-list window)
	  (cons hs old-hs))))

(defun button-fn (window mouse-state)
  (let ((hs (hotspot-under-position window
				    (mouse-state-position mouse-state))))
    (if hs
	(progn
	  (setq *active-hs* hs)
	  (funcall (my-hotspot-function-to-call hs) window mouse-state hs))
      (documentation-print "nothing is picked"))
    ))

(defun default-fn (window mouse-state hs)
  (let ((region (my-hotspot-region hs)))
    (bitblt window
	    (region-left region) (region-bottom region)
	    window
	    (region-left region) (region-bottom region)
	    (region-width region) (region-height region)
	    boole-c1)
    (if (equal *hs-action-type* 'select-any-key-word)
	(pop-up-cascading-menu-choose (my-hotspot-yes-no-menu hs))
      (pop-up-cascading-menu-choose (my-hotspot-menu-to-pop-up hs)))
    (bitblt window
	    (region-left region) (region-bottom region)
	    window
	    (region-left region) (region-bottom region)
	    (region-width region) (region-height region)
	    boole-c1)))


Ko-Haw Nieh
General Electric Company               | ARPA: nieh@ge-crd.arpa            
Corporate Research and Development     | UUCP: nieh@moose.steinmetz.ge.com 
P.O BOX 8, K1-ES224 		       | UUCP: {uunet!}steinmetz!nieh!crd  
Schenectady, NY 12301		       | 518-387-7431