~hypedyn-team/hypedyn/2.4

« back to all changes in this revision

Viewing changes to src/common/hypertextpane.scm

  • Committer: Alex Mitchell
  • Date: 2013-07-26 03:15:10 UTC
  • Revision ID: alexm@nus.edu.sg-20130726031510-x3e0arv4ydp4pmae
alt text: save changes to default text back to the doc on closing, now can open and close a node without losing changes or crashing

Show diffs side-by-side

added added

removed removed

Lines of Context:
21
21
(begin
22
22
  (require "../kawa/miscutils.scm")
23
23
  (require "../kawa/ui/component.scm")
 
24
  (require "../kawa/ui/container.scm")
24
25
  (require "../kawa/ui/events.scm")
25
26
  (require "../kawa/ui/text.scm")
26
27
  (require "../kawa/ui/cursor.scm")
28
29
  (require "../kawa/ui/undo.scm")
29
30
  (require "../kawa/color.scm")
30
31
  (require "../kawa/graphics-kawa.scm") ; for open-image-file
 
32
  (require "../kawa/strings.scm")
31
33
  
32
34
  (require "objects.scm")
33
35
  (require "datatable.scm") ;; get
191
193
        
192
194
    ;; links in editor text
193
195
    
 
196
    
 
197
    
 
198
    ;; TODO: alt text
 
199
    ;; 1) fix link position - should cover the length of the component
 
200
    ;; 2) make sure the component has linkID attribute (and clickback?)
 
201
    ;; 3) update link start/end in datastructure when saving (currently its constantly updated, is this a problem?)
 
202
    
 
203
    
 
204
    ; parse a document to find the components
 
205
    (define (parse-document)
 
206
      (let* ((the-editor (ask this-obj 'getcomponent))
 
207
             (the-doc (ask this-obj 'getdocument))
 
208
             (the-text (get-text the-editor))
 
209
             (link-offset 0)
 
210
             (iterator (<javax.swing.text.ElementIterator> the-doc)))
 
211
        
 
212
        ; helper function to walk the document
 
213
        (define (walk-document element :: <javax.swing.text.Element>)
 
214
          (if (not (is-null? element))
 
215
              (begin
 
216
                (display element)
 
217
                (let* ((as :: <javax.swing.text.AttributeSet> (element:getAttributes))
 
218
                       (this-linkID (get-attribute-linkID as)))
 
219
                  (format #t "element attributes: ~a [~a]~%~!" as  this-linkID)
 
220
                  ; is it a link? (element is a panel, and has a linkID)
 
221
                  (if (and
 
222
                       (as:containsAttribute
 
223
                        javax.swing.text.AbstractDocument:ElementNameAttribute
 
224
                        javax.swing.text.StyleConstants:ComponentElementName)
 
225
                       (not (is-null? this-linkID)))
 
226
                      (let* ((the-component :: <javax.swing.JComponent> (javax.swing.text.StyleConstants:getComponent as))
 
227
                             (the-component-class (the-component:getClass)))
 
228
                        (format #t "component: ~a~%~!" the-component-class)
 
229
                        (if (instance? the-component javax.swing.JPanel)
 
230
                            (let* ((children (get-container-children the-component))
 
231
                                   (first-panel (list-ref children 0))
 
232
                                   (first-panel-children (get-container-children first-panel))
 
233
                                   (the-text-pane :: <javax.swing.JTextPane> (list-ref first-panel-children 0))
 
234
                                   (this-link (get 'links this-linkID))
 
235
                                   (link-text (the-text-pane:getText))
 
236
                                   (link-text-len (string-length link-text))
 
237
                                   (offset-link-start (+ (element:getStartOffset) link-offset))
 
238
                                   (offset-link-end (+ (element:getEndOffset) link-offset))
 
239
                                   (doc-link-len (- offset-link-end offset-link-start)))
 
240
                                   (format #t "the-text-pane: ~a~%~!" (the-text-pane:getText))
 
241
                              
 
242
                              ; insert link text into the extracted document content
 
243
                              (set! the-text (string-replace the-text
 
244
                                                             link-text
 
245
                                                             offset-link-start
 
246
                                                             offset-link-end))
 
247
                              
 
248
                              ; update the link positions
 
249
                              (if (not (is-null? this-link))
 
250
                                  (begin
 
251
                                    (ask this-link 'set-start-index! offset-link-start)
 
252
                                    (ask this-link 'set-end-index! (+ offset-link-start link-text-len))))
 
253
                              
 
254
                              ; update the link offset
 
255
                              (set! link-offset (+ link-offset (- link-text-len doc-link-len)))
 
256
 
 
257
                              (format #t "doc text after insert (link-offset: ~a): ~a~%~!" link-offset the-text)
 
258
                              )))))
 
259
                (walk-document (iterator:next)))))
 
260
 
 
261
        (format #t "doc text: ~a~%~!" the-text)
 
262
        (walk-document (iterator:next))
 
263
        (display "end\n")
 
264
        
 
265
        ; return the text
 
266
        the-text))
 
267
    
 
268
    
 
269
    
 
270
    
 
271
    
194
272
    ; clickback for links
195
273
    (define (clickback this-linkID)
196
274
      (display "clickback in hypertext pane ")(newline)
689
767
 
690
768
     ; get the hypertextnode's text
691
769
    (define (gettext)
692
 
      (get-text the-editor))
 
770
      ;(get-text the-editor)
 
771
      (parse-document)
 
772
      )
693
773
    
694
774
    ; get a section of the text
695
775
    (define (gettextsection in-start in-end)
1161
1241
    (obj-put this-obj 'init
1162
1242
             (lambda (self) 
1163
1243
               (init)))
 
1244
    (obj-put this-obj 'parse-document
 
1245
             (lambda (self)
 
1246
               (parse-document)))
1164
1247
    (obj-put this-obj 'dirty?
1165
1248
             (lambda (self) (dirty?)))
1166
1249
    (obj-put this-obj 'set-dirty!
1251
1334
             (lambda (self proc)
1252
1335
               (set! htp-endupdate proc)
1253
1336
               ))
 
1337
    (obj-put this-obj 'set-clickback
 
1338
             (lambda (self this-linkID start-index len)
 
1339
               (set-clickback this-linkID start-index len)
 
1340
               ))
1254
1341
    ;; based on the selection, determine whether to enable newlink button
1255
1342
    (obj-put this-obj 'selection-newlink-check
1256
1343
             (lambda (self)
1257
1344
               (check-links-overlap (getselstart) (getselend))))
1258
1345
    this-obj))
1259
 
 
 
1346
    
1260
1347
; read-only hypertextpane
1261
1348
(define (make-hypertextpane-readonly
1262
1349
         w h