Re: CCL Editor Extendability [Cocoa IDE v1 project]

History or Future
Let me describe a use case from 1994 (MCL 2.0, running on a Powerbook  
180 (68030@16MHz, 8MB RAM),
may be I can rewrite/update this using ccl in the near future?

A software was written allowing a historian to analyze about 150  
interviews, each containing about  50 Pages of written Text, thereby  
relating pieces of text to a hierarchy of themes.
Since the documents were protocols of recorded interviews they  
contained errors and had to be corrected during the analysis, so the  
assignment had to be dynamic - buffer marks.
The Software allowed to work on multiple interviews at once, and  
provided a browser window showing the list of themes and the assigned  
pieces of text, updated in realtime.
The text-window had graphical markers at the beginning and end of each  
text-block and allowed to drag them at will.
I used fred to allow to easily mark text and do the assignments, to  
draw the markers, adjusted the cursor when the mouse pointed to a  
marker, and even let them blink on key-handler-idle.

If I had to write the same thing today, I wouldn't know how to do it  
( without reinventing a lot of fred in framework xxx )!

Ralf Stoye



P.S.
here are some snippets of code from the project related to the click  
handler and drawing code

;;;; handle clicks
(defmethod view-click-event-handler ((view Archiv-fred-window-fred- 
item) where)
   (cond (...
          (select-or-move-textblock view where)
          (apply-to-all-archiv-windows #'archiv-window-update))
         (T (call-next-method))))


(defun select-or-move-textblock (view where)
...
  (when theTB ; we found an TextBlock:
       (ecase *multi-click-count*
         (3 (ed-info-or-new view))
         (2
          ;doubleclick on a textblockmark, select the Textblock:
          (archiv-window-select-textblock myWindow theTB)
          )
         (1
          ;click isnt a doubleclick, maybe user want to move a mark:
          (progn
            (setq TBStart (buffer-position (textblock-start  
theTB)) ;save tbs positions before moving
                  TBEnd (buffer-position (textblock-end theTB)))
            ; dragging:
            (setq dragedPos (fred-drag-to view where))
            (if (ccl::%i= FredPos dragedPos) ; user dragged:
              (progn (set-mark (fred-buffer view) FredPos)
                     (fred-update view))
              (progn
              (when (multiple-value-bind (start end) (selection-range  
view)
                      (and (ccl::%i= TBStart start) (ccl::%i= TBEnd  
end)))
                (setq reselect? T)) ;when the tb was selected,  
remember this to reselect later
              (set-mark (if (ccl::%i= FredPos TBStart)
                          (textblock-start theTB)
                          (textblock-end theTB))
                        dragedPos)
              ; wenn das Ende jetzt vorm Anfang ist, vertausche  
einfach die Positionen:
              (setq TBStart (buffer-position (textblock-start theTB))
                    TBEnd (buffer-position (textblock-end theTB)))
              (set-mark (textblock-start theTB) (ccl::%imin TBStart  
TBEnd))
              (set-mark (textblock-end theTB) (ccl::%imax TBStart  
TBEnd))
              (set-archiv-doc-dirty myWindow (archiv-DocID myWindow) T)
              (when reselect?
                (archiv-window-select-textblock myWindow theTB))
              (invalidate-view view)))))))))

;;;; drawing (called during  view-draw-contents)
(defmethod fred-update :after ((view Archiv-fred-window-fred-item))
   (when *Archiv-fred-draw-theTB-Tails* (draw-the-TB-tails view)))

(defmethod draw-the-tb-tails ((view Archiv-fred-window-fred-item)
                               &optional (draw-mode 1))
   (declare (optimize (speed 3) (safety 0) (space 0)))
   (with-accessors ((TheWindow view-window)
                    (start-mark fred-display-start-mark)
                    (frec frec)) view
     (when TheWindow
       (with-accessors ((archiv-doc-tbs archiv-doc-tbs-direct))  
(archiv-connector TheWindow)
         (with-focused-view view
           (let* ((dest-bitmap (rref (wptr  
TheWindow) :windowrecord.port.portbits))
                  (min-vis-pos (buffer-position start-mark))
                  (max-vis-pos (buffer-line-end start-mark
                                                (buffer-position start- 
mark)
                                                (ccl::frec-screen- 
lines frec)))
                  tbPos aktVpos aktHpos)
             (declare (dynamic-extent TheWindow start-mark frec dest- 
bitmap min-vis-pos max-vis-pos
                                      tbPos aktVpos aktHpos))
             (rlet ((source-rect :rect :topleft #@(0 0) :bottomright  
#@(16 9))
                    (dest-rect-start :rect :topleft #@(0  
0) :bottomright #@(16 9))
                    (dest-rect-end :rect :topleft #@(0 0) :bottomright  
#@(16 9)))
               (#_offsetrect dest-rect-start -1 (- (- (font-line- 
height (view-font view))
                                                             1)))
               (#_offsetrect dest-rect-end (ccl::%i- 1 (rref dest-rect- 
end :rect.right)) -6)
               (dovector (TB archiv-doc-tbs)
                 ;draw the start of tb:
                 (setq tbPos (buffer-position (textblock-start TB)))
                 (when  (and (ccl::%i<= min-vis-pos tbPos)   ;  (<=   
min-vis-pos tbPos max-vis-pos) it's visible!
                            (ccl::%i<= tbPos max-vis-pos))
                   (setq aktVpos (fred-vpos view tbPos)
                         aktHpos (fred-hpos view tbPos))
                   (#_offsetRect dest-rect-end aktHpos aktVpos)
                   (#_copyBits *left-text-arrow-bitmap* dest-bitmap  
source-rect
                    dest-rect-end draw-mode (%null-ptr))
                   (#_offsetRect dest-rect-end (- aktHpos) (-  
aktVpos))))))))) ))
_______________________________________________
info-mcl mailing list
[email protected]
http://clozure.com/mailman/listinfo/info-mcl