ew-data.el

   1 (provide 'ew-data)
   2
   3 (defun ew-make-anchor (column str)
   4   (let ((anchor (make-symbol str)))
   5     (put anchor 'anchor anchor)
   6     (put anchor 'prev-frag anchor)
   7     (put anchor 'next-frag anchor)
   8     (put anchor 'prev-token anchor)
   9     (put anchor 'next-token anchor)
  10     (put anchor 'column column)
  11     (put anchor 'line-length 0)
  12     anchor))
  13
  14 (defun ew-terminate (anchor)
  15   (let ((frag (get anchor 'prev-frag))
  16         (line-length (get anchor 'column)))
  17     (while (null (get frag 'line-length))
  18       (put frag 'line-length line-length)
  19       (setq frag (get frag 'prev-frag)))))
  20
  21 (defun ew-tokenize-frag (anchor frag)
  22   (put frag 'prev-token (get anchor 'prev-token))
  23   (put frag 'next-token anchor)
  24   (put (get anchor 'prev-token) 'next-token frag)
  25   (put anchor 'prev-token frag)
  26   frag)
  27
  28 (defun ew-add-frag (anchor start end type)
  29   (let ((frag (make-symbol (substring (symbol-name anchor) start end))))
  30     (put frag 'anchor anchor)
  31     (put frag 'start start)
  32     (put frag 'end end)
  33     (put frag 'type type)
  34     (put frag 'prev-frag (get anchor 'prev-frag))
  35     (put frag 'next-frag anchor)
  36     (put (get anchor 'prev-frag) 'next-frag frag)
  37     (put anchor 'prev-frag frag)
  38     (put frag 'decode (or (get type 'decode) 'ew-decode-none))
  39     (if (string-match "\r\n\\(.*\r\n\\)*" (symbol-name frag))
  40         (let ((prev-line-length (+ (get anchor 'column) (match-beginning 0)))
  41               (next-line-column (- (length (symbol-name frag)) (match-end 0)))
  42               (tmp frag))
  43           (while (null (get tmp 'line-length))
  44             (put tmp 'line-length prev-line-length)
  45             (setq tmp (get tmp 'prev-frag)))
  46           (put anchor 'column next-line-column))
  47       (put anchor 'column (+ (get anchor 'column) (length (symbol-name frag)))))
  48     frag))
  49
  50 (defun ew-add-open (anchor start end type)
  51   (let ((frag (ew-add-frag anchor start end type)))
  52     (put frag 'prev-open (get anchor 'prev-open))
  53     (put anchor 'prev-open frag)
  54     frag))
  55
  56 (defun ew-add-close (anchor start end type)
  57   (let ((frag (ew-add-frag anchor start end type)))
  58     (put frag 'pair (get anchor 'prev-open))
  59     (put (get anchor 'prev-open) 'pair frag)
  60     (put anchor 'prev-open (get (get frag 'pair) 'prev-open))
  61     frag))
  62
  63 (defun ew-add-token (anchor start end type)
  64   (ew-tokenize-frag anchor (ew-add-frag anchor start end type)))
  65
  66 (defun ew-add-close-token (anchor start end type)
  67   (ew-tokenize-frag anchor (ew-add-close anchor start end type)))
  68
  69 ;;; listup
  70
  71 (defun ew-frag-list (anchor)
  72   (let ((res ())
  73         (tmp (get anchor 'prev-frag)))
  74     (while (not (eq anchor tmp))
  75       (setq res (cons tmp res)
  76             tmp (get tmp 'prev-frag)))
  77     res))
  78
  79 (defun ew-token-list (anchor)
  80   (let ((res ())
  81         (tmp (get anchor 'prev-token)))
  82     (while (not (eq anchor tmp))
  83       (setq res (cons tmp res)
  84             tmp (get tmp 'prev-token)))
  85     res))
  86
  87 (defun ew-pair-list (anchor)
  88   (mapcar
  89    (lambda (frag)
  90      (cons (symbol-value (get frag 'type))
  91            frag))
  92    (ew-frag-list anchor)))
  93
  94 ;;; phrase marking
  95
  96 (defun ew-mark-phrase (frag1 frag2)
  97   (while (not (eq frag1 frag2))
  98     (unless (ew-comment-frag-p frag2)
  99       (put frag2 'decode 'ew-decode-phrase))
 100     (setq frag2 (get frag2 'prev-frag)))
 101   (unless (ew-comment-frag-p frag2)
 102     (put frag2 'decode 'ew-decode-phrase))
 103   (setq frag2 (get frag2 'prev-frag))
 104   (while (not (get frag2 'prev-token))
 105     (unless (ew-comment-frag-p frag2)
 106       (put frag2 'decode 'ew-decode-phrase))
 107     (setq frag2 (get frag2 'prev-frag))))
 108
 109 ;;; frag predicate
 110
 111 (defun ew-comment-frag-p (frag)
 112   (member (get frag 'type)
 113           '(ew:raw-cm-begin-tok
 114             ew:raw-cm-end-tok
 115             ew:raw-cm-nested-begin-tok
 116             ew:raw-cm-nested-end-tok
 117             ew:raw-cm-texts-tok
 118             ew:raw-cm-wsp-tok
 119             ew:raw-cm-fold-tok
 120             ew:raw-cm-qfold-tok
 121             ew:raw-cm-qpair-tok)))
 122
 123 (defun ew-special-frag-p (frag)
 124   (member (get frag 'type)
 125           '(ew:raw-lt-tok
 126             ew:raw-gt-tok
 127             ew:raw-at-tok
 128             ew:raw-comma-tok
 129             ew:raw-semicolon-tok
 130             ew:raw-colon-tok
 131             ew:raw-dot-tok
 132             ew:raw-qs-begin-tok
 133             ew:raw-qs-end-tok
 134             ew:raw-dl-begin-tok
 135             ew:raw-dl-end-tok
 136             ew:raw-cm-begin-tok
 137             ew:raw-cm-end-tok)))