/[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.13 by rstrandh, Tue Mar 15 04:31:59 2005 UTC revision 1.14 by rstrandh, Tue Mar 15 05:39:24 2005 UTC
# Line 24  Line 24 
24    
25  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26  ;;;  ;;;
 ;;; this should really go in syntax.lisp  
   
 (defclass parse-tree ()  
   ((start-mark :initarg :start-mark :reader start-mark)  
    (size :initarg :size)))  
   
 (defgeneric start-offset (parse-tree))  
   
 (defmethod start-offset ((tree parse-tree))  
   (offset (start-mark tree)))  
   
 (defgeneric end-offset (parse-tree))  
   
 (defmethod end-offset ((tree parse-tree))  
   (with-slots (start-mark size) tree  
      (+ (offset start-mark) size)))  
   
 (defclass lexer ()  
   ((buffer :initarg :buffer :reader buffer)))  
   
 (defgeneric nb-lexemes (lexer))  
 (defgeneric lexeme (lexer pos))  
 (defgeneric insert-lexeme (lexer pos lexeme))  
 (defgeneric delete-invalid-lexemes (lexer from to))  
 (defgeneric inter-lexeme-object-p (lexer object))  
 (defgeneric skip-inter-lexeme-objects (lexer scan))  
 (defgeneric update-lex (lexer start-pos end))  
   
 (defclass incremental-lexer (lexer)  
   ((lexemes :initform (make-instance 'standard-flexichain) :reader lexemes)))  
   
 (defmethod nb-lexemes ((lexer incremental-lexer))  
   (nb-elements (lexemes lexer)))  
   
 (defmethod lexeme ((lexer incremental-lexer) pos)  
   (element* (lexemes lexer) pos))  
   
 (defmethod insert-lexeme ((lexer incremental-lexer) pos lexeme)  
   (insert* (lexemes lexer) pos lexeme))  
   
 (defmethod delete-invalid-lexemes ((lexer incremental-lexer) from to)  
   "delete all lexemes between FROM and TO and return the first invalid  
 position in the lexemes of LEXER"  
   (with-slots (lexemes) lexer  
      (let ((start 1)  
            (end (nb-elements lexemes)))  
        ;; use binary search to find the first lexeme to delete  
        (loop while (< start end)  
              do (let ((middle (floor (+ start end) 2)))  
                   (if (mark< (end-offset (element* lexemes middle)) from)  
                       (setf start (1+ middle))  
                       (setf end middle))))  
        ;; delete lexemes  
        (loop until (or (= start (nb-elements lexemes))  
                        (mark> (start-mark (element* lexemes start)) to))  
              do (delete* lexemes start))  
        start)))  
   
 (defmethod skip-inter-lexeme-objects ((lexer incremental-lexer) scan)  
   (loop until (end-of-buffer-p scan)  
         while (inter-lexeme-object-p lexer (object-after scan))  
         do (forward-object scan)))  
   
 (defmethod update-lex ((lexer incremental-lexer) start-pos end)  
   (let ((scan (clone-mark (low-mark (buffer lexer)) :left)))  
     (setf (offset scan)  
           (end-offset (lexeme lexer (1- start-pos))))  
     (loop do (skip-inter-lexeme-objects lexer scan)  
           until (if (end-of-buffer-p end)  
                     (end-of-buffer-p scan)  
                     (mark> scan end))  
           do (let* ((start-mark (clone-mark scan))  
                     (lexeme (next-lexeme scan))  
                     (size (- (offset scan) (offset start-mark))))  
                (setf (slot-value lexeme 'start-mark) start-mark  
                      (slot-value lexeme 'size) size)  
                (insert-lexeme lexer start-pos lexeme))  
              (incf start-pos))))  
   
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
 ;;;  
27  ;;; grammar classes  ;;; grammar classes
28    
29  (defclass html-sym (parse-tree)  (defclass html-sym (parse-tree)
30    ((badness :initform 0 :initarg :badness :reader badness)    ((badness :initform 0 :initarg :badness :reader badness)))
    (message :initform "" :initarg :message :reader message)))  
31    
32  (defmethod parse-tree-better ((t1 html-sym) (t2 html-sym))  (defmethod parse-tree-better ((t1 html-sym) (t2 html-sym))
33    (and (eq (class-of t1) (class-of t2))    (and (eq (class-of t1) (class-of t2))
# Line 194  position in the lexemes of LEXER" Line 112  position in the lexemes of LEXER"
112  (defclass word (html-element) ())  (defclass word (html-element) ())
113  (defclass delimiter (html-element) ())  (defclass delimiter (html-element) ())
114    
115  (defun next-lexeme (scan)  (defmethod next-lexeme ((lexer html-lexer) scan)
116    (flet ((fo () (forward-object scan)))    (flet ((fo () (forward-object scan)))
117      (let ((object (object-after scan)))      (let ((object (object-after scan)))
118        (case object        (case object

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

  ViewVC Help
Powered by ViewVC 1.1.5