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-lf-to-crlf (str)
  11   (let ((i 0) (j 0) (l (length str)) result)
  12     (while (< j l)
  13       (when (equal (aref str j) ?\n)
  14         (setq result (ew-rcons*
  15                       result
  16                       (substring str i j)
  17                       "\r")
  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-crlf-to-lf (str)
  27   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  28     (while (< j l-)
  29       (when (and (equal (aref str j) ?\r)
  30                  (equal (aref str (1+ j)) ?\n))
  31         (setq result (ew-rcons*
  32                       result
  33                       (substring str i j))
  34               j (1+ j)
  35               i j))
  36       (setq j (1+ j)))
  37     (when (< i l)
  38       (setq result (ew-rcons*
  39                     result
  40                     (substring str i))))
  41     (apply 'concat (nreverse result))))
  42
  43 (defun ew-lf-crlf-to-crlf (str)
  44   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  45     (while (< j l)
  46       (cond
  47        ((and (< j l-)
  48              (equal (aref str j) ?\r)
  49              (equal (aref str (1+ j)) ?\n))
  50         (setq j (1+ j)))
  51        ((equal (aref str j) ?\n)
  52         (setq result (ew-rcons*
  53                       result
  54                       (substring str i j)
  55                       "\r")
  56               i j)))
  57       (setq j (1+ j)))
  58     (when (< i l)
  59       (setq result (ew-rcons*
  60                     result
  61                     (substring str i))))
  62     (apply 'concat (nreverse result))))
  63
  64 (defun ew-crlf-unfold (str)
  65   (let* ((i 0) (j 0) (l (length str)) (l- (- l 2)) result)
  66     (while (< j l-)
  67       (when (and (equal (aref str j) ?\r)
  68                  (equal (aref str (1+ j)) ?\n)
  69                  (member (aref str (+ j 2)) '(?\t ?\ )))
  70         (setq result (ew-rcons*
  71                       result
  72                       (substring str i j))
  73               j (+ j 2)
  74               i j))
  75       (setq j (1+ j)))
  76     (when (< i l)
  77       (setq result (ew-rcons*
  78                     result
  79                     (substring str i))))
  80     (apply 'concat (nreverse result))))
  81
  82 (defun ew-lf-unfold (str)
  83   (let* ((i 0) (j 0) (l (length str)) (l- (- l 1)) result)
  84     (while (< j l-)
  85       (when (and (equal (aref str j) ?\n)
  86                  (member (aref str (+ j 1)) '(?\t ?\ )))
  87         (setq result (ew-rcons*
  88                       result
  89                       (substring str i j))
  90               j (+ j 1)
  91               i j))
  92       (setq j (1+ j)))
  93     (when (< i l)
  94       (setq result (ew-rcons*
  95                     result
  96                     (substring str i))))
  97     (apply 'concat (nreverse result))))
  98
  99 (defun ew-cut-generic (str chars)
 100   (let ((i 0) (j 0) (l (length str)) result)
 101     (while (< j l)
 102       (when (member (aref str j) chars)
 103         (setq result (ew-rcons*
 104                       result
 105                       (substring str i j))
 106               i (1+ j)))
 107       (setq j (1+ j)))
 108     (when (< i l)
 109       (setq result (ew-rcons*
 110                     result
 111                     (substring str i))))
 112     (apply 'concat (nreverse result))))
 113
 114 (defun ew-cut-cr-lf (str)  (ew-cut-generic str '(?\r ?\n)))
 115 (defun ew-cut-cr (str) (ew-cut-generic str '(?\r)))
 116 (defun ew-cut-lf (str) (ew-cut-generic str '(?\n)))
 117
 118 (defmacro ew-crlf-line-generic-define ()
 119   (let ((str (make-symbol "str"))
 120         (others-fun (make-symbol "others-fun"))
 121         (fold-fun (make-symbol "fold-fun"))
 122         (crlf-fun (make-symbol "crlf-fun"))
 123         (bare-cr-fun (make-symbol "bare-cr-fun"))
 124         (bare-lf-fun (make-symbol "bare-lf-fun"))
 125         (p (make-symbol "p"))
 126         (q (make-symbol "q"))
 127         (r (make-symbol "r")))
 128     `(defun ew-crlf-line-generic
 129        (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
 130        (let ((,p 0) (,q (length ,str)) ,r)
 131          (while (< ,p ,q)
 132            (setq ,r ,p)
 133            (lex-scan-unibyte ,str ,p ,q
 134              ((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
 135              ((?\r ?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
 136              ((?\r ?\n) (when ,crlf-fun (funcall ,crlf-fun ,r ,p)))
 137              ((?\r) (when ,bare-cr-fun (funcall ,bare-cr-fun ,r ,p)))
 138              ((?\n) (when ,bare-lf-fun (funcall ,bare-lf-fun ,r ,p)))
 139              (() (error "something wrong"))))
 140          ,q))))
 141
 142 (ew-crlf-line-generic-define)
 143
 144 (defmacro ew-crlf-line-convert-define ()
 145   (let ((str (make-symbol "str"))
 146         (others-fun (make-symbol "others-fun"))
 147         (fold-fun (make-symbol "fold-fun"))
 148         (crlf-fun (make-symbol "crlf-fun"))
 149         (bare-cr-fun (make-symbol "bare-cr-fun"))
 150         (bare-lf-fun (make-symbol "bare-lf-fun"))
 151         (index (make-symbol "index"))
 152         (result (make-symbol "result"))
 153         (start (make-symbol "starx"))
 154         (end (make-symbol "end")))
 155     `(defun ew-crlf-line-convert
 156        (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
 157        (let ((,index 0) ,result)
 158          (when (> (ew-crlf-line-generic
 159                       ,str
 160                     ,@(mapcar
 161                        (lambda (fun)
 162                          `(when ,fun
 163                             (lambda (,start ,end)
 164                               (when (< ,index ,start)
 165                                 (setq ,result
 166                                       (ew-rcons* ,result
 167                                                  (substring ,str ,index ,start))))
 168                               (setq ,result
 169                                     (ew-rcons* ,result
 170                                                (funcall ,fun
 171                                                         (substring ,str ,start ,end)))
 172                                     ,index ,end))))
 173                        (list others-fun fold-fun crlf-fun bare-cr-fun bare-lf-fun)))
 174                   ,index)
 175            (setq ,result
 176                  (ew-rcons* ,result
 177                             (substring ,str ,index))))
 178          (apply 'concat (nreverse ,result))))))
 179
 180 (ew-crlf-line-convert-define)
 181
 182 (defmacro ew-lf-line-generic-define ()
 183   (let ((str (make-symbol "str"))
 184         (others-fun (make-symbol "others-fun"))
 185         (fold-fun (make-symbol "fold-fun"))
 186         (lf-fun (make-symbol "lf-fun"))
 187         (p (make-symbol "p"))
 188         (q (make-symbol "q"))
 189         (r (make-symbol "r")))
 190     `(defun ew-lf-line-generic
 191        (,str ,others-fun ,fold-fun ,lf-fun)
 192        (let ((,p 0) (,q (length ,str)) ,r)
 193          (while (< ,p ,q)
 194            (setq ,r ,p)
 195            (lex-scan-unibyte ,str ,p ,q
 196              ((+ [^ "\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
 197              ((?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
 198              ((?\n) (when ,lf-fun (funcall ,lf-fun ,r ,p)))
 199              (() (error "something wrong"))))
 200          ,q))))
 201
 202 (ew-lf-line-generic-define)
 203
 204 (defmacro ew-lf-line-convert-define ()
 205   (let ((str (make-symbol "str"))
 206         (others-fun (make-symbol "others-fun"))
 207         (fold-fun (make-symbol "fold-fun"))
 208         (lf-fun (make-symbol "lf-fun"))
 209         (index (make-symbol "index"))
 210         (result (make-symbol "result"))
 211         (start (make-symbol "starx"))
 212         (end (make-symbol "end")))
 213     `(defun ew-lf-line-convert
 214        (,str ,others-fun ,fold-fun ,lf-fun)
 215        (let ((,index 0) ,result)
 216          (when (> (ew-lf-line-generic
 217                       ,str
 218                     ,@(mapcar
 219                        (lambda (fun)
 220                          `(when ,fun
 221                             (lambda (,start ,end)
 222                               (when (< ,index ,start)
 223                                 (setq ,result
 224                                       (ew-rcons* ,result
 225                                                  (substring ,str ,index ,start))))
 226                               (setq ,result
 227                                     (ew-rcons* ,result
 228                                                (funcall ,fun
 229                                                         (substring ,str ,start ,end)))
 230                                     ,index ,end))))
 231                        (list others-fun fold-fun lf-fun)))
 232                   ,index)
 233            (setq ,result
 234                  (ew-rcons* ,result
 235                             (substring ,str ,index))))
 236          (apply 'concat (nreverse ,result))))))
 237
 238 (ew-lf-line-convert-define)