(require 'ew-var)
+(require 'ew-util)
(provide 'ew-data)
(defun ew-make-anchor (column str)
(let ((anchor (make-symbol str)))
(put anchor 'anchor anchor)
+ (put anchor 'type 'ew:*anchor*)
(put anchor 'prev-frag anchor)
(put anchor 'next-frag anchor)
- (put anchor 'prev-token anchor)
- (put anchor 'next-token anchor)
(put anchor 'column column)
(put anchor 'line-length 0)
anchor))
(put frag 'line-length line-length)
(setq frag (get frag 'prev-frag)))))
-(defun ew-tokenize-frag (anchor frag)
- (put frag 'prev-token (get anchor 'prev-token))
- (put frag 'next-token anchor)
- (put (get anchor 'prev-token) 'next-token frag)
- (put anchor 'prev-token frag)
- frag)
-
-(defun ew-add-frag (anchor start end type)
+(defsubst ew-add-frag (anchor start end type)
(let ((frag (make-symbol (substring (symbol-name anchor) start end))))
(put frag 'anchor anchor)
- (put frag 'start start)
- (put frag 'end end)
(put frag 'type type)
(put frag 'prev-frag (get anchor 'prev-frag))
(put frag 'next-frag anchor)
(put anchor 'column (+ (get anchor 'column) (length (symbol-name frag)))))
frag))
-(defun ew-add-open (anchor start end type)
- (let ((frag (ew-add-frag anchor start end type)))
- (put frag 'prev-open (get anchor 'prev-open))
- (put anchor 'prev-open frag)
- frag))
-
-(defun ew-add-close (anchor start end type)
- (let ((frag (ew-add-frag anchor start end type)))
- (put frag 'pair (get anchor 'prev-open))
- (put (get anchor 'prev-open) 'pair frag)
- (put anchor 'prev-open (get (get frag 'pair) 'prev-open))
- frag))
-
-(defun ew-add-token (anchor start end type)
- (ew-tokenize-frag anchor (ew-add-frag anchor start end type)))
-
-(defun ew-add-close-token (anchor start end type)
- (ew-tokenize-frag anchor (ew-add-close anchor start end type)))
-
;;; listup
(defun ew-frag-list (anchor)
tmp (get tmp 'prev-frag)))
res))
-(defun ew-token-list (anchor)
- (let ((res ())
- (tmp (get anchor 'prev-token)))
- (while (not (eq anchor tmp))
- (setq res (cons tmp res)
- tmp (get tmp 'prev-token)))
- res))
-
(defun ew-pair-list (anchor)
(mapcar
(lambda (frag)
frag))
(ew-frag-list anchor)))
+(defun ew-search-sticked-eword (frag start)
+ (let* ((texts (symbol-name frag)) (len (length texts)))
+ (catch 'return
+ (while (string-match ew-encoded-word-regexp texts start)
+ (when (and (or ew-permit-null-encoded-text
+ (< (match-beginning 3) (match-end 3)))
+ (or ew-ignore-75bytes-limit
+ (<= (- (match-end 0) (match-beginning 0)) 75))
+ (or ew-permit-sticked-comment
+ (not (= (match-beginning 0) 0))
+ (not (ew-comment-frag-p (get frag 'prev-frag))))
+ (or ew-permit-sticked-comment
+ (not (= (match-end 0) (length texts)))
+ (not (ew-comment-frag-p (get frag 'next-frag))))
+ (or ew-permit-sticked-special
+ (not (= (match-beginning 0) 0))
+ (ew-comment-frag-p (get frag 'prev-frag))
+ (not (ew-special-frag-p (get frag 'prev-frag))))
+ (or ew-permit-sticked-special
+ (not (= (match-end 0) (length texts)))
+ (ew-comment-frag-p (get frag 'next-frag))
+ (not (ew-special-frag-p (get frag 'next-frag))))
+ )
+ (throw 'return t))
+ (setq start (1- (match-end 0))))
+ nil)))
+
(defun ew-separate-eword (frag1 frag2 targets)
(while (not (eq frag1 frag2))
(when (and (memq (get frag1 'type) targets)
- (string-match ew-encoded-word-regexp
- (symbol-name frag1))
+ (ew-search-sticked-eword frag1 0)
(or (< 0 (match-beginning 0))
(< (match-end 0) (length (symbol-name frag1)))))
- (let ((atom (symbol-name frag1))
- (base (get frag1 'start))
+ (let ((texts (symbol-name frag1))
(start (match-end 0))
result
frag)
(when (< 0 (match-beginning 0))
- (setq frag (make-symbol (substring atom 0 (match-beginning 0)))
- result(ew-rcons* result frag))
- (put frag 'start base)
- (put frag 'end (+ base (match-beginning 0))))
- (setq frag (make-symbol (substring atom (match-beginning 0) (match-end 0)))
+ (setq frag (make-symbol (substring texts 0 (match-beginning 0)))
+ result (ew-rcons* result frag)))
+ (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
result (ew-rcons* result frag))
- (put frag 'start (+ base (match-beginning 0)))
- (put frag 'end (+ base (match-end 0)))
(when (cdr result)
(put frag 'prev-frag (cadr result))
(put (cadr result) 'next-frag frag)
(setq frag (cadr result)))
(put frag 'prev-frag (get frag1 'prev-frag))
(put (get frag1 'prev-frag) 'next-frag frag)
- (while (string-match ew-encoded-word-regexp atom start)
+ (while (ew-search-sticked-eword frag1 start)
(when (< start (match-beginning 0))
- (setq frag (make-symbol (substring atom start (match-beginning 0)))
+ (setq frag (make-symbol (substring texts start (match-beginning 0)))
result (ew-rcons* result frag))
- (put frag 'start (+ base start))
- (put frag 'end (+ base (match-beginning 0)))
(put frag 'prev-frag (cadr result))
(put (cadr result) 'next-frag frag))
- (setq frag (make-symbol (substring atom (match-beginning 0) (match-end 0)))
+ (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
result (ew-rcons* result frag)
start (match-end 0))
- (put frag 'start (+ base (match-beginning 0)))
- (put frag 'end (+ base (match-end 0)))
(put frag 'prev-frag (cadr result))
(put (cadr result) 'next-frag frag))
(when (< start (length (symbol-name frag1)))
- (setq frag (make-symbol (substring atom start))
+ (setq frag (make-symbol (substring texts start))
result (ew-rcons* result frag))
- (put frag 'start (+ base start))
- (put frag 'end (get frag1 'end))
(put frag 'prev-frag (cadr result))
(put (cadr result) 'next-frag frag))
(setq frag (car result))
(ew-separate-eword
frag1 frag2
(if ew-decode-quoted-encoded-word
- '(ew:raw-atom-tok
- ew:raw-qs-texts-tok)
- '(ew:raw-atom-tok))))
+ '(ew:atom
+ ew:qs-texts)
+ '(ew:atom)))
+ (setq frag1 (get (get frag1 'prev-frag) 'next-frag)))
(while (not (eq frag1 frag2))
+ (setq frag2 (get frag2 'prev-frag))
(unless (ew-comment-frag-p frag2)
- (put frag2 'decode 'ew-decode-phrase))
- (setq frag2 (get frag2 'prev-frag)))
- (unless (ew-comment-frag-p frag2)
- (put frag2 'decode 'ew-decode-phrase))
- (setq frag2 (get frag2 'prev-frag))
- (while (not (get frag2 'prev-token))
+ (put frag2 'decode 'ew-decode-phrase)))
+ (while (not (ew-token-last-frag-p
+ (setq frag2 (get frag2 'prev-frag))))
(unless (ew-comment-frag-p frag2)
- (put frag2 'decode 'ew-decode-phrase))
- (setq frag2 (get frag2 'prev-frag))))
+ (put frag2 'decode 'ew-decode-phrase))))
;;; frag predicate
+(defun ew-token-last-frag-p (frag)
+ (member (get frag 'type)
+ '(ew:*anchor*
+ ew:lt
+ ew:gt
+ ew:at
+ ew:comma
+ ew:semicolon
+ ew:colon
+ ew:dot
+ ew:atom
+ ew:qs-end
+ ew:dl-end)))
+
(defun ew-comment-frag-p (frag)
(member (get frag 'type)
- '(ew:raw-cm-begin-tok
- ew:raw-cm-end-tok
- ew:raw-cm-nested-begin-tok
- ew:raw-cm-nested-end-tok
- ew:raw-cm-texts-tok
- ew:raw-cm-wsp-tok
- ew:raw-cm-fold-tok
- ew:raw-cm-qfold-tok
- ew:raw-cm-qpair-tok)))
+ '(ew:cm-begin
+ ew:cm-end
+ ew:cm-nested-begin
+ ew:cm-nested-end
+ ew:cm-texts
+ ew:cm-wsp
+ ew:cm-fold
+ ew:cm-qfold
+ ew:cm-qpair)))
(defun ew-special-frag-p (frag)
(member (get frag 'type)
- '(ew:raw-lt-tok
- ew:raw-gt-tok
- ew:raw-at-tok
- ew:raw-comma-tok
- ew:raw-semicolon-tok
- ew:raw-colon-tok
- ew:raw-dot-tok
- ew:raw-qs-begin-tok
- ew:raw-qs-end-tok
- ew:raw-dl-begin-tok
- ew:raw-dl-end-tok
- ew:raw-cm-begin-tok
- ew:raw-cm-end-tok)))
+ '(ew:lt
+ ew:gt
+ ew:at
+ ew:comma
+ ew:semicolon
+ ew:colon
+ ew:dot
+ ew:qs-begin
+ ew:qs-end
+ ew:dl-begin
+ ew:dl-end
+ ew:cm-begin
+ ew:cm-end)))
projects / elisp / flim.git / blobdiff