ew-line.el

   1 (require 'lex)
   2 (require 'ew-util)
   3 (provide 'ew-line)
   4
   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)
   9
  10 (defun ew-tab-to-space (str)
  11   (let ((i 0) (j 0) (l (length str)) result)
  12     (while (< j l)
  13       (when (equal (aref str j) ?\t)
  14         (setq result (ew-rcons*
  15                       result
  16                       (substring str i j)
  17                       " ")
  18               i j))
  19       (setq j (1+ j)))
  20     (when (< i l)
  21       (setq result (ew-rcons*
  22                     result
  23                     (substring str i))))
  24     (apply 'concat (nreverse result))))
  25
  26 (defun ew-lf-to-crlf (str)
  27   (let ((i 0) (j 0) (l (length str)) result)
  28     (while (< j l)
  29       (when (equal (aref str j) ?\n)
  30         (setq result (ew-rcons*
  31                       result
  32                       (substring str i j)
  33                       "\r")
  34               i j))
  35       (setq j (1+ j)))
  36     (when (< i l)
  37       (setq result (ew-rcons*
  38                     result
  39                     (substring str i))))
  40     (apply 'concat (nreverse result))))
  41
  42 (defun ew-crlf-to-lf (str)
  43   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  44     (while (< j l-)
  45       (when (and (equal (aref str j) ?\r)
  46                  (equal (aref str (1+ j)) ?\n))
  47         (setq result (ew-rcons*
  48                       result
  49                       (substring str i j))
  50               j (1+ j)
  51               i j))
  52       (setq j (1+ j)))
  53     (when (< i l)
  54       (setq result (ew-rcons*
  55                     result
  56                     (substring str i))))
  57     (apply 'concat (nreverse result))))
  58
  59 (defun ew-lf-crlf-to-crlf (str)
  60   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  61     (while (< j l)
  62       (cond
  63        ((and (< j l-)
  64              (equal (aref str j) ?\r)
  65              (equal (aref str (1+ j)) ?\n))
  66         (setq j (1+ j)))
  67        ((equal (aref str j) ?\n)
  68         (setq result (ew-rcons*
  69                       result
  70                       (substring str i j)
  71                       "\r")
  72               i j)))
  73       (setq j (1+ j)))
  74     (when (< i l)
  75       (setq result (ew-rcons*
  76                     result
  77                     (substring str i))))
  78     (apply 'concat (nreverse result))))
  79
  80 (defun ew-crlf-unfold (str)
  81   (let* ((i 0) (j 0) (l (length str)) (l- (- l 2)) result)
  82     (while (< j l-)
  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*
  87                       result
  88                       (substring str i j))
  89               j (+ j 2)
  90               i j))
  91       (setq j (1+ j)))
  92     (when (< i l)
  93       (setq result (ew-rcons*
  94                     result
  95                     (substring str i))))
  96     (apply 'concat (nreverse result))))
  97
  98 (defun ew-lf-unfold (str)
  99   (let* ((i 0) (j 0) (l (length str)) (l- (- l 1)) result)
 100     (while (< j l-)
 101       (when (and (equal (aref str j) ?\n)
 102                  (member (aref str (+ j 1)) '(?\t ?\ )))
 103         (setq result (ew-rcons*
 104                       result
 105                       (substring str i j))
 106               j (+ j 1)
 107               i j))
 108       (setq j (1+ j)))
 109     (when (< i l)
 110       (setq result (ew-rcons*
 111                     result
 112                     (substring str i))))
 113     (apply 'concat (nreverse result))))
 114
 115 (defun ew-cut-generic (str chars)
 116   (let ((i 0) (j 0) (l (length str)) result)
 117     (while (< j l)
 118       (when (member (aref str j) chars)
 119         (setq result (ew-rcons*
 120                       result
 121                       (substring str i j))
 122               i (1+ j)))
 123       (setq j (1+ j)))
 124     (when (< i l)
 125       (setq result (ew-rcons*
 126                     result
 127                     (substring str i))))
 128     (apply 'concat (nreverse result))))
 129
 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)))
 133
 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)
 147          (while (< ,p ,q)
 148            (setq ,r ,p)
 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"))))
 156          ,q))))
 157 (ew-crlf-generic-define)
 158
 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)
 170          (while (< ,p ,q)
 171            (setq ,r ,p)
 172            (lex-scan-unibyte ,str ,p ,q
 173              (() (error "something wrong"))
 174              (((* [^ "\r"])
 175                (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
 176                (* ?\r)
 177                (?\r ?\n [" \t"]))
 178               (when (and ,others-fun (< ,r (- ,p 3))) (funcall ,others-fun ,r (- ,p 3)))
 179               (when ,fold-fun (funcall ,fold-fun (- ,p 3) ,p)))
 180              (((* [^ "\r"])
 181                (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
 182                (* ?\r)
 183                (?\r ?\n))
 184               (when (and ,others-fun (< ,r (- ,p 2))) (funcall ,others-fun ,r (- ,p 2)))
 185               (when ,nl-fun (funcall ,nl-fun (- ,p 2) ,p)))
 186              (((* [^ "\r"])
 187                (* (+ ?\r) [^ "\r\n"] (* [^ "\r"]))
 188                (* ?\r))
 189               (when ,others-fun (funcall ,others-fun ,r ,p)))))
 190          ,q))))
 191 (ew-crlf-line-generic-define)
 192
 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)
 205          (while (< ,p ,q)
 206            (setq ,r ,p)
 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"))))
 213          ,q))))
 214 (ew-lf-generic-define)
 215
 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)
 227          (while (< ,p ,q)
 228            (setq ,r ,p)
 229            (lex-scan-unibyte ,str ,p ,q
 230              (() (error "something wrong"))
 231              ((+ [^ "\n"])
 232               (when ,others-fun (funcall ,others-fun ,r ,p)))
 233              ((?\n [" \t"])
 234               (when ,fold-fun (funcall ,fold-fun ,r ,p)))
 235              (?\n
 236               (when ,nl-fun (funcall ,nl-fun ,r ,p)))))
 237          ,q))))
 238 (ew-lf-line-generic-define)
 239
 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")))
 248     `(defun ,name
 249        (,str ,@funcs-vars)
 250        (let ((,index 0) ,result ,tmp)
 251          (when (> (,generic
 252                    ,str
 253                    ,@(mapcar
 254                       (lambda (fun)
 255                         `(when ,fun
 256                            (lambda (,start ,end)
 257                              (setq ,tmp (funcall ,fun (substring ,str ,start ,end)))
 258                              (when ,tmp
 259                                (when (< ,index ,start)
 260                                  (setq ,result
 261                                        (ew-rcons* ,result
 262                                                   (substring ,str ,index ,start))))
 263                                (setq ,result (ew-rcons* ,result ,tmp)
 264                                      ,index ,end)))))
 265                       funcs-vars))
 266                   ,index)
 267            (setq ,result
 268                  (ew-rcons* ,result
 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)
 275
 276 (defmacro ew-fold-define (name convert nl)
 277   `(defun ,name (str start-column line-length)
 278      (let ((column start-column))
 279        (,convert str
 280          (lambda (line)
 281            (let ((start 0)
 282                  (end (length line))
 283                  result tmp fold width)
 284              (while (and (< start end)
 285                          (progn
 286                            (when (<= column 1)
 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)
 298                    (progn
 299                      (when (and fold (not (= line-length column)))
 300                        (setcdr fold (cons (car fold) (cdr fold)))
 301                        (setcar fold ,nl)
 302                        (setq column (+ width
 303                                        (if (eq (cdr result) fold)
 304                                            0
 305                                          (string-width (cadr result))))))
 306                      (if (<= line-length column)
 307                          (setq result (ew-rcons* result ,nl)
 308                                column 0
 309                                fold nil)
 310                        (setq fold result)))
 311                  (setq fold result))
 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)))
 316              (when (< start end)
 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)))
 322                (setcar fold ,nl))
 323              (apply 'concat (nreverse result))))
 324          (lambda (fold) (setq column 1) nil)
 325          (lambda (nl) (setq column 0) nil)))))
 326
 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")
 329
 330 (defun ew-crlf-refold (string start-column line-length)
 331   (ew-crlf-fold (ew-crlf-unfold string) start-column line-length))
 332
 333 (defun ew-lf-refold (string start-column line-length)
 334   (ew-lf-fold (ew-lf-unfold string) start-column line-length))