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-search-sticked-eword (frag start)
  60   (let* ((texts (symbol-name frag)) (len (length texts)))
  61     (catch 'return
  62       (while (string-match ew-encoded-word-regexp texts start)
  63         (when (and (or ew-permit-null-encoded-text
  64                        (< (match-beginning 3) (match-end 3)))
  65                    (or ew-ignore-75bytes-limit
  66                        (<= (- (match-end 0) (match-beginning 0)) 75))
  67                    (or ew-permit-sticked-comment
  68                        (not (= (match-beginning 0) 0))
  69                        (not (ew-comment-frag-p (get frag 'prev-frag))))
  70                    (or ew-permit-sticked-comment
  71                        (not (= (match-end 0) (length texts)))
  72                        (not (ew-comment-frag-p (get frag 'next-frag))))
  73                    (or ew-permit-sticked-special
  74                        (not (= (match-beginning 0) 0))
  75                        (ew-comment-frag-p (get frag 'prev-frag))
  76                        (not (ew-special-frag-p (get frag 'prev-frag))))
  77                    (or ew-permit-sticked-special
  78                        (not (= (match-end 0) (length texts)))
  79                        (ew-comment-frag-p (get frag 'next-frag))
  80                        (not (ew-special-frag-p (get frag 'next-frag))))
  81                    )
  82           (throw 'return t))
  83         (setq start (1- (match-end 0))))
  84       nil)))
  85
  86 (defun ew-separate-eword (frag1 frag2 targets)
  87   (while (not (eq frag1 frag2))
  88     (when (and (memq (get frag1 'type) targets)
  89                (ew-search-sticked-eword frag1 0)
  90                (or (< 0 (match-beginning 0))
  91                    (< (match-end 0) (length (symbol-name frag1)))))
  92       (let ((texts (symbol-name frag1))
  93             (start (match-end 0))
  94             result
  95             frag)
  96         (when (< 0 (match-beginning 0))
  97           (setq frag (make-symbol (substring texts 0 (match-beginning 0)))
  98                 result (ew-rcons* result frag)))
  99         (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
 100               result (ew-rcons* result frag))
 101         (when (cdr result)
 102           (put frag 'prev-frag (cadr result))
 103           (put (cadr result) 'next-frag frag)
 104           (setq frag (cadr result)))
 105         (put frag 'prev-frag (get frag1 'prev-frag))
 106         (put (get frag1 'prev-frag) 'next-frag frag)
 107         (while (ew-search-sticked-eword frag1 start)
 108           (when (< start (match-beginning 0))
 109             (setq frag (make-symbol (substring texts start (match-beginning 0)))
 110                   result (ew-rcons* result frag))
 111             (put frag 'prev-frag (cadr result))
 112             (put (cadr result) 'next-frag frag))
 113           (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
 114                 result (ew-rcons* result frag)
 115                 start (match-end 0))
 116           (put frag 'prev-frag (cadr result))
 117           (put (cadr result) 'next-frag frag))
 118         (when (< start (length (symbol-name frag1)))
 119           (setq frag (make-symbol (substring texts start))
 120                 result (ew-rcons* result frag))
 121           (put frag 'prev-frag (cadr result))
 122           (put (cadr result) 'next-frag frag))
 123         (setq frag (car result))
 124         (put frag 'next-frag (get frag1 'next-frag))
 125         (put (get frag1 'next-frag) 'prev-frag frag)
 126         (while result
 127           (setq frag (car result)
 128                 result (cdr result))
 129           (put frag 'anchor (get frag1 'anchor))
 130           (put frag 'type (get frag1 'type))
 131           (put frag 'decode (get frag1 'decode))
 132           (put frag 'line-length (get frag1 'line-length)))))
 133     (setq frag1 (get frag1 'next-frag))))
 134
 135 ;;; phrase marking
 136
 137 (defun ew-mark-phrase (frag1 frag2)
 138   (when ew-decode-sticked-encoded-word
 139     (ew-separate-eword
 140      frag1 frag2
 141      (if ew-decode-quoted-encoded-word
 142          '(ew:atom
 143            ew:qs-texts)
 144        '(ew:atom)))
 145     (setq frag1 (get (get frag1 'prev-frag) 'next-frag)))
 146   (while (not (eq frag1 frag2))
 147     (setq frag2 (get frag2 'prev-frag))
 148     (unless (ew-comment-frag-p frag2)
 149       (put frag2 'decode 'ew-decode-phrase)))
 150   (while (not (ew-token-last-frag-p
 151                (setq frag2 (get frag2 'prev-frag))))
 152     (unless (ew-comment-frag-p frag2)
 153       (put frag2 'decode 'ew-decode-phrase))))
 154
 155 ;;; frag predicate
 156
 157 (defun ew-token-last-frag-p (frag)
 158   (member (get frag 'type)
 159           '(ew:*anchor*
 160             ew:lt
 161             ew:gt
 162             ew:at
 163             ew:comma
 164             ew:semicolon
 165             ew:colon
 166             ew:dot
 167             ew:atom
 168             ew:qs-end
 169             ew:dl-end)))
 170
 171 (defun ew-comment-frag-p (frag)
 172   (member (get frag 'type)
 173           '(ew:cm-begin
 174             ew:cm-end
 175             ew:cm-nested-begin
 176             ew:cm-nested-end
 177             ew:cm-texts
 178             ew:cm-wsp
 179             ew:cm-fold
 180             ew:cm-qfold
 181             ew:cm-qpair)))
 182
 183 (defun ew-special-frag-p (frag)
 184   (member (get frag 'type)
 185           '(ew:lt
 186             ew:gt
 187             ew:at
 188             ew:comma
 189             ew:semicolon
 190             ew:colon
 191             ew:dot
 192             ew:qs-begin
 193             ew:qs-end
 194             ew:dl-begin
 195             ew:dl-end
 196             ew:cm-begin
 197             ew:cm-end)))