ew-data.el

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