ew-data.el

   1 (require 'ew-var)
   2 (provide 'ew-data)
   3
   4 (defun ew-make-anchor (column str)
   5   (let ((anchor (make-symbol str)))
   6     (put anchor 'anchor anchor)
   7     (put anchor 'prev-frag anchor)
   8     (put anchor 'next-frag anchor)
   9     (put anchor 'prev-token anchor)
  10     (put anchor 'next-token anchor)
  11     (put anchor 'column column)
  12     (put anchor 'line-length 0)
  13     anchor))
  14
  15 (defun ew-terminate (anchor)
  16   (let ((frag (get anchor 'prev-frag))
  17         (line-length (get anchor 'column)))
  18     (while (null (get frag 'line-length))
  19       (put frag 'line-length line-length)
  20       (setq frag (get frag 'prev-frag)))))
  21
  22 (defun ew-tokenize-frag (anchor frag)
  23   (put frag 'prev-token (get anchor 'prev-token))
  24   (put frag 'next-token anchor)
  25   (put (get anchor 'prev-token) 'next-token frag)
  26   (put anchor 'prev-token frag)
  27   frag)
  28
  29 (defun ew-add-frag (anchor start end type)
  30   (let ((frag (make-symbol (substring (symbol-name anchor) start end))))
  31     (put frag 'anchor anchor)
  32     (put frag 'start start)
  33     (put frag 'end end)
  34     (put frag 'type type)
  35     (put frag 'prev-frag (get anchor 'prev-frag))
  36     (put frag 'next-frag anchor)
  37     (put (get anchor 'prev-frag) 'next-frag frag)
  38     (put anchor 'prev-frag frag)
  39     (put frag 'decode (or (get type 'decode) 'ew-decode-none))
  40     (if (string-match "\r\n\\(.*\r\n\\)*" (symbol-name frag))
  41         (let ((prev-line-length (+ (get anchor 'column) (match-beginning 0)))
  42               (next-line-column (- (length (symbol-name frag)) (match-end 0)))
  43               (tmp frag))
  44           (while (null (get tmp 'line-length))
  45             (put tmp 'line-length prev-line-length)
  46             (setq tmp (get tmp 'prev-frag)))
  47           (put anchor 'column next-line-column))
  48       (put anchor 'column (+ (get anchor 'column) (length (symbol-name frag)))))
  49     frag))
  50
  51 (defun ew-add-open (anchor start end type)
  52   (let ((frag (ew-add-frag anchor start end type)))
  53     (put frag 'prev-open (get anchor 'prev-open))
  54     (put anchor 'prev-open frag)
  55     frag))
  56
  57 (defun ew-add-close (anchor start end type)
  58   (let ((frag (ew-add-frag anchor start end type)))
  59     (put frag 'pair (get anchor 'prev-open))
  60     (put (get anchor 'prev-open) 'pair frag)
  61     (put anchor 'prev-open (get (get frag 'pair) 'prev-open))
  62     frag))
  63
  64 (defun ew-add-token (anchor start end type)
  65   (ew-tokenize-frag anchor (ew-add-frag anchor start end type)))
  66
  67 (defun ew-add-close-token (anchor start end type)
  68   (ew-tokenize-frag anchor (ew-add-close anchor start end type)))
  69
  70 ;;; listup
  71
  72 (defun ew-frag-list (anchor)
  73   (let ((res ())
  74         (tmp (get anchor 'prev-frag)))
  75     (while (not (eq anchor tmp))
  76       (setq res (cons tmp res)
  77             tmp (get tmp 'prev-frag)))
  78     res))
  79
  80 (defun ew-token-list (anchor)
  81   (let ((res ())
  82         (tmp (get anchor 'prev-token)))
  83     (while (not (eq anchor tmp))
  84       (setq res (cons tmp res)
  85             tmp (get tmp 'prev-token)))
  86     res))
  87
  88 (defun ew-pair-list (anchor)
  89   (mapcar
  90    (lambda (frag)
  91      (cons (symbol-value (get frag 'type))
  92            frag))
  93    (ew-frag-list anchor)))
  94
  95 (defun ew-separate-eword (frag1 frag2 targets)
  96   (while (not (eq frag1 frag2))
  97     (when (and (memq (get frag1 'type) targets)
  98                (string-match ew-encoded-word-regexp
  99                              (symbol-name frag1))
 100                (or (< 0 (match-beginning 0))
 101                    (< (match-end 0) (length (symbol-name frag1)))))
 102       (let ((atom (symbol-name frag1))
 103             (base (get frag1 'start))
 104             (start (match-end 0))
 105             result
 106             frag)
 107         (when (< 0 (match-beginning 0))
 108           (setq frag (make-symbol (substring atom 0 (match-beginning 0)))
 109                 result(ew-rcons* result frag))
 110           (put frag 'start base)
 111           (put frag 'end (+ base (match-beginning 0))))
 112         (setq frag (make-symbol (substring atom (match-beginning 0) (match-end 0)))
 113               result (ew-rcons* result frag))
 114         (put frag 'start (+ base (match-beginning 0)))
 115         (put frag 'end (+ base (match-end 0)))
 116         (when (cdr result)
 117           (put frag 'prev-frag (cadr result))
 118           (put (cadr result) 'next-frag frag)
 119           (setq frag (cadr result)))
 120         (put frag 'prev-frag (get frag1 'prev-frag))
 121         (put (get frag1 'prev-frag) 'next-frag frag)
 122         (while (string-match ew-encoded-word-regexp atom start)
 123           (when (< start (match-beginning 0))
 124             (setq frag (make-symbol (substring atom start (match-beginning 0)))
 125                   result (ew-rcons* result frag))
 126             (put frag 'start (+ base start))
 127             (put frag 'end (+ base (match-beginning 0)))
 128             (put frag 'prev-frag (cadr result))
 129             (put (cadr result) 'next-frag frag))
 130           (setq frag (make-symbol (substring atom (match-beginning 0) (match-end 0)))
 131                 result (ew-rcons* result frag)
 132                 start (match-end 0))
 133           (put frag 'start (+ base (match-beginning 0)))
 134           (put frag 'end (+ base (match-end 0)))
 135           (put frag 'prev-frag (cadr result))
 136           (put (cadr result) 'next-frag frag))
 137         (when (< start (length (symbol-name frag1)))
 138           (setq frag (make-symbol (substring atom start))
 139                 result (ew-rcons* result frag))
 140           (put frag 'start (+ base start))
 141           (put frag 'end (get frag1 'end))
 142           (put frag 'prev-frag (cadr result))
 143           (put (cadr result) 'next-frag frag))
 144         (setq frag (car result))
 145         (put frag 'next-frag (get frag1 'next-frag))
 146         (put (get frag1 'next-frag) 'prev-frag frag)
 147         (while result
 148           (setq frag (car result)
 149                 result (cdr result))
 150           (put frag 'anchor (get frag1 'anchor))
 151           (put frag 'type (get frag1 'type))
 152           (put frag 'decode (get frag1 'decode))
 153           (put frag 'line-length (get frag1 'line-length)))))
 154     (setq frag1 (get frag1 'next-frag))))
 155
 156 ;;; phrase marking
 157
 158 (defun ew-mark-phrase (frag1 frag2)
 159   (when ew-decode-sticked-encoded-word
 160     (ew-separate-eword
 161      frag1 frag2
 162      (if ew-decode-quoted-encoded-word
 163          '(ew:raw-atom-tok
 164            ew:raw-qs-texts-tok)
 165        '(ew:raw-atom-tok))))
 166   (while (not (eq frag1 frag2))
 167     (unless (ew-comment-frag-p frag2)
 168       (put frag2 'decode 'ew-decode-phrase))
 169     (setq frag2 (get frag2 'prev-frag)))
 170   (unless (ew-comment-frag-p frag2)
 171     (put frag2 'decode 'ew-decode-phrase))
 172   (setq frag2 (get frag2 'prev-frag))
 173   (while (not (get frag2 'prev-token))
 174     (unless (ew-comment-frag-p frag2)
 175       (put frag2 'decode 'ew-decode-phrase))
 176     (setq frag2 (get frag2 'prev-frag))))
 177
 178 ;;; frag predicate
 179
 180 (defun ew-comment-frag-p (frag)
 181   (member (get frag 'type)
 182           '(ew:raw-cm-begin-tok
 183             ew:raw-cm-end-tok
 184             ew:raw-cm-nested-begin-tok
 185             ew:raw-cm-nested-end-tok
 186             ew:raw-cm-texts-tok
 187             ew:raw-cm-wsp-tok
 188             ew:raw-cm-fold-tok
 189             ew:raw-cm-qfold-tok
 190             ew:raw-cm-qpair-tok)))
 191
 192 (defun ew-special-frag-p (frag)
 193   (member (get frag 'type)
 194           '(ew:raw-lt-tok
 195             ew:raw-gt-tok
 196             ew:raw-at-tok
 197             ew:raw-comma-tok
 198             ew:raw-semicolon-tok
 199             ew:raw-colon-tok
 200             ew:raw-dot-tok
 201             ew:raw-qs-begin-tok
 202             ew:raw-qs-end-tok
 203             ew:raw-dl-begin-tok
 204             ew:raw-dl-end-tok
 205             ew:raw-cm-begin-tok
 206             ew:raw-cm-end-tok)))