(put 'ew-lf-line-generic 'lisp-indent-function 1)
(put 'ew-lf-line-convert 'lisp-indent-function 1)
+(defun ew-tab-to-space (str)
+ (let ((i 0) (j 0) (l (length str)) result)
+ (while (< j l)
+ (when (equal (aref str j) ?\t)
+ (setq result (ew-rcons*
+ result
+ (substring str i j)
+ " ")
+ i j))
+ (setq j (1+ j)))
+ (when (< i l)
+ (setq result (ew-rcons*
+ result
+ (substring str i))))
+ (apply 'concat (nreverse result))))
+
(defun ew-lf-to-crlf (str)
(let ((i 0) (j 0) (l (length str)) result)
(while (< j l)
(defun ew-cut-cr (str) (ew-cut-generic str '(?\r)))
(defun ew-cut-lf (str) (ew-cut-generic str '(?\n)))
-(defmacro ew-crlf-line-generic-define ()
+(defmacro ew-crlf-generic-define ()
(let ((str (make-symbol "str"))
(others-fun (make-symbol "others-fun"))
(fold-fun (make-symbol "fold-fun"))
- (crlf-fun (make-symbol "crlf-fun"))
- (bare-cr-fun (make-symbol "bare-cr-fun"))
- (bare-lf-fun (make-symbol "bare-lf-fun"))
+ (nl-fun (make-symbol "nl-fun"))
+ (cr-fun (make-symbol "cr-fun"))
+ (lf-fun (make-symbol "lf-fun"))
(p (make-symbol "p"))
(q (make-symbol "q"))
(r (make-symbol "r")))
- `(defun ew-crlf-line-generic
- (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
+ `(defun ew-crlf-generic
+ (,str ,others-fun ,fold-fun ,nl-fun ,cr-fun ,lf-fun)
(let ((,p 0) (,q (length ,str)) ,r)
(while (< ,p ,q)
(setq ,r ,p)
(lex-scan-unibyte ,str ,p ,q
((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
((?\r ?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
- ((?\r ?\n) (when ,crlf-fun (funcall ,crlf-fun ,r ,p)))
- ((?\r) (when ,bare-cr-fun (funcall ,bare-cr-fun ,r ,p)))
- ((?\n) (when ,bare-lf-fun (funcall ,bare-lf-fun ,r ,p)))
+ ((?\r ?\n) (when ,nl-fun (funcall ,nl-fun ,r ,p)))
+ ((?\r) (when ,cr-fun (funcall ,cr-fun ,r ,p)))
+ ((?\n) (when ,lf-fun (funcall ,lf-fun ,r ,p)))
(() (error "something wrong"))))
,q))))
+(ew-crlf-generic-define)
+(defmacro ew-crlf-line-generic-define ()
+ (let ((str (make-symbol "str"))
+ (others-fun (make-symbol "others-fun"))
+ (fold-fun (make-symbol "fold-fun"))
+ (nl-fun (make-symbol "nl-fun"))
+ (p (make-symbol "p"))
+ (q (make-symbol "q"))
+ (r (make-symbol "r")))
+ `(defun ew-crlf-line-generic
+ (,str ,others-fun ,fold-fun ,nl-fun)
+ (let ((,p 0) (,q (length ,str)) ,r)
+ (while (< ,p ,q)
+ (setq ,r ,p)
+ (lex-scan-unibyte ,str ,p ,q
+ (() (error "something wrong"))
+ (((* [^ "\r\n"])
+ (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
+ (* ?\r)
+ (?\r ?\n [" \t"]))
+ (when (and ,others-fun (< ,r (- ,p 3))) (funcall ,others-fun ,r (- ,p 3)))
+ (when ,fold-fun (funcall ,fold-fun (- ,p 3) ,p)))
+ (((* [^ "\r\n"])
+ (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
+ (* ?\r)
+ (?\r ?\n))
+ (when (and ,others-fun (< ,r (- ,p 2))) (funcall ,others-fun ,r (- ,p 2)))
+ (when ,nl-fun (funcall ,nl-fun (- ,p 2) ,p)))
+ (((* [^ "\r\n"])
+ (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
+ (* ?\r))
+ (when ,others-fun (funcall ,others-fun ,r ,p)))))
+ ,q))))
(ew-crlf-line-generic-define)
-(defmacro ew-crlf-line-convert-define ()
+(defmacro ew-lf-generic-define ()
(let ((str (make-symbol "str"))
(others-fun (make-symbol "others-fun"))
(fold-fun (make-symbol "fold-fun"))
- (crlf-fun (make-symbol "crlf-fun"))
- (bare-cr-fun (make-symbol "bare-cr-fun"))
- (bare-lf-fun (make-symbol "bare-lf-fun"))
- (index (make-symbol "index"))
- (result (make-symbol "result"))
- (start (make-symbol "starx"))
- (end (make-symbol "end")))
- `(defun ew-crlf-line-convert
- (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
- (let ((,index 0) ,result)
- (when (> (ew-crlf-line-generic
- ,str
- ,@(mapcar
- (lambda (fun)
- `(when ,fun
- (lambda (,start ,end)
- (when (< ,index ,start)
- (setq ,result
- (ew-rcons* ,result
- (substring ,str ,index ,start))))
- (setq ,result
- (ew-rcons* ,result
- (funcall ,fun
- (substring ,str ,start ,end)))
- ,index ,end))))
- (list others-fun fold-fun crlf-fun bare-cr-fun bare-lf-fun)))
- ,index)
- (setq ,result
- (ew-rcons* ,result
- (substring ,str ,index))))
- (apply 'concat (nreverse ,result))))))
-
-(ew-crlf-line-convert-define)
+ (nl-fun (make-symbol "nl-fun"))
+ (cr-fun (make-symbol "cr-fun"))
+ (p (make-symbol "p"))
+ (q (make-symbol "q"))
+ (r (make-symbol "r")))
+ `(defun ew-lf-generic
+ (,str ,others-fun ,fold-fun ,nl-fun ,cr-fun)
+ (let ((,p 0) (,q (length ,str)) ,r)
+ (while (< ,p ,q)
+ (setq ,r ,p)
+ (lex-scan-unibyte ,str ,p ,q
+ ((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
+ ((?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
+ ((?\n) (when ,nl-fun (funcall ,nl-fun ,r ,p)))
+ ((?\r) (when ,cr-fun (funcall ,cr-fun ,r ,p)))
+ (() (error "something wrong"))))
+ ,q))))
+(ew-lf-generic-define)
(defmacro ew-lf-line-generic-define ()
(let ((str (make-symbol "str"))
(others-fun (make-symbol "others-fun"))
(fold-fun (make-symbol "fold-fun"))
- (lf-fun (make-symbol "lf-fun"))
+ (nl-fun (make-symbol "nl-fun"))
(p (make-symbol "p"))
(q (make-symbol "q"))
(r (make-symbol "r")))
`(defun ew-lf-line-generic
- (,str ,others-fun ,fold-fun ,lf-fun)
+ (,str ,others-fun ,fold-fun ,nl-fun)
(let ((,p 0) (,q (length ,str)) ,r)
(while (< ,p ,q)
(setq ,r ,p)
(lex-scan-unibyte ,str ,p ,q
- ((+ [^ "\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
- ((?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
- ((?\n) (when ,lf-fun (funcall ,lf-fun ,r ,p)))
- (() (error "something wrong"))))
+ (() (error "something wrong"))
+ ((+ [^ "\n"])
+ (when ,others-fun (funcall ,others-fun ,r ,p)))
+ ((?\n [" \t"])
+ (when ,fold-fun (funcall ,fold-fun ,r ,p)))
+ (?\n
+ (when ,nl-fun (funcall ,nl-fun ,r ,p)))))
,q))))
-
(ew-lf-line-generic-define)
-(defmacro ew-lf-line-convert-define ()
+(defmacro ew-generic-convert-define (name generic &rest funcs)
(let ((str (make-symbol "str"))
- (others-fun (make-symbol "others-fun"))
- (fold-fun (make-symbol "fold-fun"))
- (lf-fun (make-symbol "lf-fun"))
+ (funcs-vars (mapcar (lambda (func) (make-symbol (symbol-name func))) funcs))
(index (make-symbol "index"))
(result (make-symbol "result"))
+ (tmp (make-symbol "tmp"))
(start (make-symbol "starx"))
(end (make-symbol "end")))
- `(defun ew-lf-line-convert
- (,str ,others-fun ,fold-fun ,lf-fun)
- (let ((,index 0) ,result)
- (when (> (ew-lf-line-generic
- ,str
- ,@(mapcar
- (lambda (fun)
- `(when ,fun
- (lambda (,start ,end)
- (when (< ,index ,start)
- (setq ,result
- (ew-rcons* ,result
- (substring ,str ,index ,start))))
- (setq ,result
- (ew-rcons* ,result
- (funcall ,fun
- (substring ,str ,start ,end)))
- ,index ,end))))
- (list others-fun fold-fun lf-fun)))
+ `(defun ,name
+ (,str ,@funcs-vars)
+ (let ((,index 0) ,result ,tmp)
+ (when (> (,generic
+ ,str
+ ,@(mapcar
+ (lambda (fun)
+ `(when ,fun
+ (lambda (,start ,end)
+ (setq ,tmp (funcall ,fun (substring ,str ,start ,end)))
+ (when ,tmp
+ (when (< ,index ,start)
+ (setq ,result
+ (ew-rcons* ,result
+ (substring ,str ,index ,start))))
+ (setq ,result (ew-rcons* ,result ,tmp)
+ ,index ,end)))))
+ funcs-vars))
,index)
(setq ,result
(ew-rcons* ,result
(substring ,str ,index))))
(apply 'concat (nreverse ,result))))))
+(ew-generic-convert-define ew-crlf-convert ew-crlf-generic others-fun fold-fun nl-fun cr-fun lf-fun)
+(ew-generic-convert-define ew-crlf-line-convert ew-crlf-line-generic others-fun fold-fun nl-fun)
+(ew-generic-convert-define ew-lf-convert ew-lf-generic others-fun fold-fun nl-fun cr-fun)
+(ew-generic-convert-define ew-lf-line-convert ew-lf-line-generic others-fun fold-fun nl-fun)
+
+(defmacro ew-fold-define (name convert nl)
+ `(defun ,name (str start-column line-length)
+ (let ((column start-column))
+ (,convert str
+ (lambda (line)
+ (let ((start 0)
+ (end (length line))
+ result tmp fold width)
+ (while (and (< start end)
+ (progn
+ (when (<= column 1)
+ (setq tmp (sref line start)
+ result (ew-rcons* result (char-to-string tmp))
+ column (+ column (char-width tmp))
+ start (char-next-index tmp start)))
+ (string-match "[ \t]" line start)))
+ (setq tmp (substring line start (match-beginning 0))
+ width (string-width tmp)
+ result (ew-rcons* result tmp)
+ column (+ column width)
+ start (match-beginning 0))
+ (if (<= line-length column)
+ (progn
+ (when (and fold (not (= line-length column)))
+ (setcdr fold (cons (car fold) (cdr fold)))
+ (setcar fold ,nl)
+ (setq column (+ width
+ (if (eq (cdr result) fold)
+ 0
+ (string-width (cadr result))))))
+ (if (<= line-length column)
+ (setq result (ew-rcons* result ,nl)
+ column 0
+ fold nil)
+ (setq fold result)))
+ (setq fold result))
+ (setq tmp (sref line (match-beginning 0))
+ result (ew-rcons* result (char-to-string tmp))
+ column (+ column (char-width tmp))
+ start (match-end 0)))
+ (when (< start end)
+ (setq tmp (substring line start)
+ result (ew-rcons* result tmp)
+ column (+ column (string-width tmp))))
+ (when (and (< line-length column) fold)
+ (setcdr fold (cons (car fold) (cdr fold)))
+ (setcar fold ,nl))
+ (apply 'concat (nreverse result))))
+ (lambda (fold) (setq column 1) nil)
+ (lambda (nl) (setq column 0) nil)))))
+
+(ew-fold-define ew-crlf-fold ew-crlf-line-convert "\r\n")
+(ew-fold-define ew-lf-fold ew-crlf-line-convert "\n")
+
+(defun ew-crlf-refold (string start-column line-length)
+ (ew-crlf-fold (ew-crlf-unfold string) start-column line-length))
-(ew-lf-line-convert-define)
+(defun ew-lf-refold (string start-column line-length)
+ (ew-lf-fold (ew-lf-unfold string) start-column line-length))
projects / elisp / flim.git / blobdiff