+++ /dev/null
-(require 'lex)
-(require 'ew-util)
-(provide 'ew-line)
-
-(put 'ew-crlf-line-generic 'lisp-indent-function 1)
-(put 'ew-crlf-line-convert 'lisp-indent-function 1)
-(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)
- (when (equal (aref str j) ?\n)
- (setq result (ew-rcons*
- result
- (substring str i j)
- "\r")
- i j))
- (setq j (1+ j)))
- (when (< i l)
- (setq result (ew-rcons*
- result
- (substring str i))))
- (apply 'concat (nreverse result))))
-
-(defun ew-crlf-to-lf (str)
- (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
- (while (< j l-)
- (when (and (equal (aref str j) ?\r)
- (equal (aref str (1+ j)) ?\n))
- (setq result (ew-rcons*
- result
- (substring str i j))
- j (1+ 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-crlf-to-crlf (str)
- (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
- (while (< j l)
- (cond
- ((and (< j l-)
- (equal (aref str j) ?\r)
- (equal (aref str (1+ j)) ?\n))
- (setq j (1+ j)))
- ((equal (aref str j) ?\n)
- (setq result (ew-rcons*
- result
- (substring str i j)
- "\r")
- i j)))
- (setq j (1+ j)))
- (when (< i l)
- (setq result (ew-rcons*
- result
- (substring str i))))
- (apply 'concat (nreverse result))))
-
-(defun ew-crlf-unfold (str)
- (let* ((i 0) (j 0) (l (length str)) (l- (- l 2)) result)
- (while (< j l-)
- (when (and (equal (aref str j) ?\r)
- (equal (aref str (1+ j)) ?\n)
- (member (aref str (+ j 2)) '(?\t ?\ )))
- (setq result (ew-rcons*
- result
- (substring str i j))
- j (+ j 2)
- i j))
- (setq j (1+ j)))
- (when (< i l)
- (setq result (ew-rcons*
- result
- (substring str i))))
- (apply 'concat (nreverse result))))
-
-(defun ew-lf-unfold (str)
- (let* ((i 0) (j 0) (l (length str)) (l- (- l 1)) result)
- (while (< j l-)
- (when (and (equal (aref str j) ?\n)
- (member (aref str (+ j 1)) '(?\t ?\ )))
- (setq result (ew-rcons*
- result
- (substring str i j))
- j (+ j 1)
- i j))
- (setq j (1+ j)))
- (when (< i l)
- (setq result (ew-rcons*
- result
- (substring str i))))
- (apply 'concat (nreverse result))))
-
-(defun ew-cut-generic (str chars)
- (let ((i 0) (j 0) (l (length str)) result)
- (while (< j l)
- (when (member (aref str j) chars)
- (setq result (ew-rcons*
- result
- (substring str i j))
- i (1+ j)))
- (setq j (1+ j)))
- (when (< i l)
- (setq result (ew-rcons*
- result
- (substring str i))))
- (apply 'concat (nreverse result))))
-
-(defun ew-cut-cr-lf (str) (ew-cut-generic str '(?\r ?\n)))
-(defun ew-cut-cr (str) (ew-cut-generic str '(?\r)))
-(defun ew-cut-lf (str) (ew-cut-generic str '(?\n)))
-
-(defmacro ew-crlf-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"))
- (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-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 ,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"])
- (* (+ ?\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"])
- (* (+ ?\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"])
- (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
- (* ?\r))
- (when ,others-fun (funcall ,others-fun ,r ,p)))))
- ,q))))
-(ew-crlf-line-generic-define)
-
-(defmacro ew-lf-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"))
- (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"))
- (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 ,nl-fun)
- (let ((,p 0) (,q (length ,str)) ,r)
- (while (< ,p ,q)
- (setq ,r ,p)
- (lex-scan-unibyte ,str ,p ,q
- (() (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-generic-convert-define (name generic &rest funcs)
- (let ((str (make-symbol "str"))
- (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 ,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))
-
-(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