/[climacs]/climacs/html-syntax.lisp
ViewVC logotype

Diff of /climacs/html-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by rstrandh, Mon Mar 7 06:51:02 2005 UTC revision 1.8 by rstrandh, Thu Mar 10 06:37:40 2005 UTC
# Line 300  Line 300 
300                           pane (- tab-width (mod x tab-width)) 0))))                           pane (- tab-width (mod x tab-width)) 0))))
301               (incf start))))               (incf start))))
302    
303    (defmethod display-parse-tree :around ((entity html-sym) syntax pane)
304      (with-slots (top bot) pane
305         (when (mark> (end-offset entity) top)
306           (call-next-method))))
307    
308    (defmethod display-parse-tree :around ((entity empty-words) syntax pane)
309      (declare (ignore syntax pane))
310      nil)
311    
312    (defmethod display-parse-tree ((entity html-token) (syntax html-syntax) pane)
313      (updating-output (pane :unique-id entity
314                             :id-test #'eq
315                             :cache-value entity
316                             :cache-test #'eq)
317        (present (coerce (region-to-sequence (start-mark entity)
318                                             (end-offset entity))
319                         'string)
320                 'string
321                 :stream pane)))
322    
323    (defmethod display-parse-tree :before ((entity html-balanced) (syntax html-syntax) pane)
324      (with-slots (start) entity
325         (display-parse-tree start syntax pane)))
326    
327    (defmethod display-parse-tree :after ((entity html-balanced) (syntax html-syntax) pane)
328      (with-slots (end) entity
329         (display-parse-tree end syntax pane)))
330    
331    (defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)
332      (with-slots (words) entity
333         (display-parse-tree words syntax pane)))
334    
335    (defmethod display-parse-tree ((entity empty-words) (syntax html-syntax) pane)
336      (declare (ignore pane))
337      nil)
338    
339    (defmethod display-parse-tree ((entity nonempty-words) (syntax html-syntax) pane)
340      (with-slots (words word) entity
341         (display-parse-tree words syntax pane)
342         (display-parse-tree word syntax pane)))
343    
344    (defmethod display-parse-tree ((entity html) (syntax html-syntax) pane)
345      (with-slots (head body) entity
346         (display-parse-tree head syntax pane)
347         (display-parse-tree body syntax pane)))
348    
349    (defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)
350      (with-slots (title) entity
351         (display-parse-tree title syntax pane)))
352    
353    (defgeneric display-parse-stack (symbol stack syntax pane))
354    
355    (defmethod display-parse-stack (symbol stack (syntax html-syntax) pane)
356      (let ((next (parse-stack-next stack)))
357        (unless (null next)
358          (display-parse-stack (parse-stack-symbol next) next syntax pane))
359        (loop for parse-tree in (reverse (parse-stack-parse-trees stack))
360              do (display-parse-tree parse-tree syntax pane))))
361    
362    (defun display-parse-state (state syntax pane)
363      (let ((top (parse-stack-top state)))
364        (if (not (null top))
365            (display-parse-stack (parse-stack-symbol top) top syntax pane)
366            (display-parse-tree (target-parse-tree state) syntax pane))))
367    
368  (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax html-syntax) current-p)  (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax html-syntax) current-p)
369    (with-slots (top bot) pane    (with-slots (top bot) pane
370       (with-slots (tokens) syntax       (with-slots (tokens) syntax
# Line 310  Line 375 
375              ;; go back to a token before bot              ;; go back to a token before bot
376              (loop until (mark<= (end-offset (element* tokens (1- end-token-index))) bot)              (loop until (mark<= (end-offset (element* tokens (1- end-token-index))) bot)
377                    do (decf end-token-index))                    do (decf end-token-index))
378              ;; for forward to the last token before bot              ;; go forward to the last token before bot
379              (loop until (or (= end-token-index (nb-elements tokens))              (loop until (or (= end-token-index (nb-elements tokens))
380                              (mark> (start-offset (element* tokens end-token-index)) bot))                              (mark> (start-offset (element* tokens end-token-index)) bot))
381                    do (incf end-token-index))                    do (incf end-token-index))
382              (let ((start-token-index end-token-index))              (let ((start-token-index end-token-index))
383                ;; go back to the first token after top                ;; go back to the first token after top, or until the previous token
384                (loop until (mark<= (end-offset (element* tokens (1- start-token-index))) top)                ;; contains a valid parser state
385                  (loop until (or (mark<= (end-offset (element* tokens (1- start-token-index))) top)
386                                  (not (null (parse-stack-top
387                                              (slot-value (element* tokens (1- start-token-index)) 'state)))))
388                      do (decf start-token-index))                      do (decf start-token-index))
389                  ;; display the parse tree if any
390                  (unless (parse-state-empty-p (slot-value (element* tokens (1- start-token-index)) 'state))
391                    (display-parse-state (slot-value (element* tokens (1- start-token-index)) 'state)
392                                         syntax
393                                         pane))
394                ;; display the tokens                ;; display the tokens
395                (loop with prev-offset = (offset top)                (loop with prev-offset = (end-offset (element* tokens (1- start-token-index)))
396                      while (< start-token-index end-token-index)                      while (< start-token-index end-token-index)
397                      do (let ((token (element* tokens start-token-index)))                      do (let ((token (element* tokens start-token-index)))
398                           (handle-whitespace pane (buffer pane) prev-offset (start-offset token))                           (handle-whitespace pane (buffer pane) prev-offset (start-offset token))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5