5 (put 'ew-crlf-line-generic 'lisp-indent-function 1)
6 (put 'ew-crlf-line-convert 'lisp-indent-function 1)
7 (put 'ew-lf-line-generic 'lisp-indent-function 1)
8 (put 'ew-lf-line-convert 'lisp-indent-function 1)
10 (defun ew-tab-to-space (str)
11 (let ((i 0) (j 0) (l (length str)) result)
13 (when (equal (aref str j) ?\t)
14 (setq result (ew-rcons*
21 (setq result (ew-rcons*
24 (apply 'concat (nreverse result))))
26 (defun ew-lf-to-crlf (str)
27 (let ((i 0) (j 0) (l (length str)) result)
29 (when (equal (aref str j) ?\n)
30 (setq result (ew-rcons*
37 (setq result (ew-rcons*
40 (apply 'concat (nreverse result))))
42 (defun ew-crlf-to-lf (str)
43 (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
45 (when (and (equal (aref str j) ?\r)
46 (equal (aref str (1+ j)) ?\n))
47 (setq result (ew-rcons*
54 (setq result (ew-rcons*
57 (apply 'concat (nreverse result))))
59 (defun ew-lf-crlf-to-crlf (str)
60 (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
64 (equal (aref str j) ?\r)
65 (equal (aref str (1+ j)) ?\n))
67 ((equal (aref str j) ?\n)
68 (setq result (ew-rcons*
75 (setq result (ew-rcons*
78 (apply 'concat (nreverse result))))
80 (defun ew-crlf-unfold (str)
81 (let* ((i 0) (j 0) (l (length str)) (l- (- l 2)) result)
83 (when (and (equal (aref str j) ?\r)
84 (equal (aref str (1+ j)) ?\n)
85 (member (aref str (+ j 2)) '(?\t ?\ )))
86 (setq result (ew-rcons*
93 (setq result (ew-rcons*
96 (apply 'concat (nreverse result))))
98 (defun ew-lf-unfold (str)
99 (let* ((i 0) (j 0) (l (length str)) (l- (- l 1)) result)
101 (when (and (equal (aref str j) ?\n)
102 (member (aref str (+ j 1)) '(?\t ?\ )))
103 (setq result (ew-rcons*
110 (setq result (ew-rcons*
113 (apply 'concat (nreverse result))))
115 (defun ew-cut-generic (str chars)
116 (let ((i 0) (j 0) (l (length str)) result)
118 (when (member (aref str j) chars)
119 (setq result (ew-rcons*
125 (setq result (ew-rcons*
128 (apply 'concat (nreverse result))))
130 (defun ew-cut-cr-lf (str) (ew-cut-generic str '(?\r ?\n)))
131 (defun ew-cut-cr (str) (ew-cut-generic str '(?\r)))
132 (defun ew-cut-lf (str) (ew-cut-generic str '(?\n)))
134 (defmacro ew-crlf-generic-define ()
135 (let ((str (make-symbol "str"))
136 (others-fun (make-symbol "others-fun"))
137 (fold-fun (make-symbol "fold-fun"))
138 (nl-fun (make-symbol "nl-fun"))
139 (cr-fun (make-symbol "cr-fun"))
140 (lf-fun (make-symbol "lf-fun"))
141 (p (make-symbol "p"))
142 (q (make-symbol "q"))
143 (r (make-symbol "r")))
144 `(defun ew-crlf-generic
145 (,str ,others-fun ,fold-fun ,nl-fun ,cr-fun ,lf-fun)
146 (let ((,p 0) (,q (length ,str)) ,r)
149 (lex-scan-unibyte ,str ,p ,q
150 ((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
151 ((?\r ?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
152 ((?\r ?\n) (when ,nl-fun (funcall ,nl-fun ,r ,p)))
153 ((?\r) (when ,cr-fun (funcall ,cr-fun ,r ,p)))
154 ((?\n) (when ,lf-fun (funcall ,lf-fun ,r ,p)))
155 (() (error "something wrong"))))
157 (ew-crlf-generic-define)
159 (defmacro ew-crlf-line-generic-define ()
160 (let ((str (make-symbol "str"))
161 (others-fun (make-symbol "others-fun"))
162 (fold-fun (make-symbol "fold-fun"))
163 (nl-fun (make-symbol "nl-fun"))
164 (p (make-symbol "p"))
165 (q (make-symbol "q"))
166 (r (make-symbol "r")))
167 `(defun ew-crlf-line-generic
168 (,str ,others-fun ,fold-fun ,nl-fun)
169 (let ((,p 0) (,q (length ,str)) ,r)
172 (lex-scan-unibyte ,str ,p ,q
173 (() (error "something wrong"))
175 (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
178 (when (and ,others-fun (< ,r (- ,p 3))) (funcall ,others-fun ,r (- ,p 3)))
179 (when ,fold-fun (funcall ,fold-fun (- ,p 3) ,p)))
181 (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
184 (when (and ,others-fun (< ,r (- ,p 2))) (funcall ,others-fun ,r (- ,p 2)))
185 (when ,nl-fun (funcall ,nl-fun (- ,p 2) ,p)))
187 (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
189 (when ,others-fun (funcall ,others-fun ,r ,p)))))
191 (ew-crlf-line-generic-define)
193 (defmacro ew-lf-generic-define ()
194 (let ((str (make-symbol "str"))
195 (others-fun (make-symbol "others-fun"))
196 (fold-fun (make-symbol "fold-fun"))
197 (nl-fun (make-symbol "nl-fun"))
198 (cr-fun (make-symbol "cr-fun"))
199 (p (make-symbol "p"))
200 (q (make-symbol "q"))
201 (r (make-symbol "r")))
202 `(defun ew-lf-generic
203 (,str ,others-fun ,fold-fun ,nl-fun ,cr-fun)
204 (let ((,p 0) (,q (length ,str)) ,r)
207 (lex-scan-unibyte ,str ,p ,q
208 ((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
209 ((?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
210 ((?\n) (when ,nl-fun (funcall ,nl-fun ,r ,p)))
211 ((?\r) (when ,cr-fun (funcall ,cr-fun ,r ,p)))
212 (() (error "something wrong"))))
214 (ew-lf-generic-define)
216 (defmacro ew-lf-line-generic-define ()
217 (let ((str (make-symbol "str"))
218 (others-fun (make-symbol "others-fun"))
219 (fold-fun (make-symbol "fold-fun"))
220 (nl-fun (make-symbol "nl-fun"))
221 (p (make-symbol "p"))
222 (q (make-symbol "q"))
223 (r (make-symbol "r")))
224 `(defun ew-lf-line-generic
225 (,str ,others-fun ,fold-fun ,nl-fun)
226 (let ((,p 0) (,q (length ,str)) ,r)
229 (lex-scan-unibyte ,str ,p ,q
230 (() (error "something wrong"))
232 (when ,others-fun (funcall ,others-fun ,r ,p)))
234 (when ,fold-fun (funcall ,fold-fun ,r ,p)))
236 (when ,nl-fun (funcall ,nl-fun ,r ,p)))))
238 (ew-lf-line-generic-define)
240 (defmacro ew-generic-convert-define (name generic &rest funcs)
241 (let ((str (make-symbol "str"))
242 (funcs-vars (mapcar (lambda (func) (make-symbol (symbol-name func))) funcs))
243 (index (make-symbol "index"))
244 (result (make-symbol "result"))
245 (tmp (make-symbol "tmp"))
246 (start (make-symbol "starx"))
247 (end (make-symbol "end")))
250 (let ((,index 0) ,result ,tmp)
256 (lambda (,start ,end)
257 (setq ,tmp (funcall ,fun (substring ,str ,start ,end)))
259 (when (< ,index ,start)
262 (substring ,str ,index ,start))))
263 (setq ,result (ew-rcons* ,result ,tmp)
269 (substring ,str ,index))))
270 (apply 'concat (nreverse ,result))))))
271 (ew-generic-convert-define ew-crlf-convert ew-crlf-generic others-fun fold-fun nl-fun cr-fun lf-fun)
272 (ew-generic-convert-define ew-crlf-line-convert ew-crlf-line-generic others-fun fold-fun nl-fun)
273 (ew-generic-convert-define ew-lf-convert ew-lf-generic others-fun fold-fun nl-fun cr-fun)
274 (ew-generic-convert-define ew-lf-line-convert ew-lf-line-generic others-fun fold-fun nl-fun)
276 (defmacro ew-fold-define (name convert nl)
277 `(defun ,name (str start-column line-length)
278 (let ((column start-column))
283 result tmp fold width)
284 (while (and (< start end)
287 (setq tmp (sref line start)
288 result (ew-rcons* result (char-to-string tmp))
289 column (+ column (char-width tmp))
290 start (char-next-index tmp start)))
291 (string-match "[ \t]" line start)))
292 (setq tmp (substring line start (match-beginning 0))
293 width (string-width tmp)
294 result (ew-rcons* result tmp)
295 column (+ column width)
296 start (match-beginning 0))
297 (if (<= line-length column)
299 (when (and fold (not (= line-length column)))
300 (setcdr fold (cons (car fold) (cdr fold)))
302 (setq column (+ width
303 (if (eq (cdr result) fold)
305 (string-width (cadr result))))))
306 (if (<= line-length column)
307 (setq result (ew-rcons* result ,nl)
312 (setq tmp (sref line (match-beginning 0))
313 result (ew-rcons* result (char-to-string tmp))
314 column (+ column (char-width tmp))
315 start (match-end 0)))
317 (setq tmp (substring line start)
318 result (ew-rcons* result tmp)
319 column (+ column (string-width tmp))))
320 (when (and (< line-length column) fold)
321 (setcdr fold (cons (car fold) (cdr fold)))
323 (apply 'concat (nreverse result))))
324 (lambda (fold) (setq column 1) nil)
325 (lambda (nl) (setq column 0) nil)))))
327 (ew-fold-define ew-crlf-fold ew-crlf-line-convert "\r\n")
328 (ew-fold-define ew-lf-fold ew-crlf-line-convert "\n")
330 (defun ew-crlf-refold (string start-column line-length)
331 (ew-crlf-fold (ew-crlf-unfold string) start-column line-length))
333 (defun ew-lf-refold (string start-column line-length)
334 (ew-lf-fold (ew-lf-unfold string) start-column line-length))