ew-line.el

   1 (require 'lex)
   2 (require 'ew-util)
   3 (provide 'ew-line)
   4
   5 (put 'ew-line-generic 'lisp-indent-function 1)
   6 (put 'ew-line-convert 'lisp-indent-function 1)
   7
   8 (defun ew-lf-to-crlf (str)
   9   (let ((i 0) (j 0) (l (length str)) result)
  10     (while (< j l)
  11       (when (equal (aref str j) ?\n)
  12         (setq result (ew-rcons*
  13                       result
  14                       (substring str i j)
  15                       "\r")
  16               i j))
  17       (setq j (1+ j)))
  18     (when (< i l)
  19       (setq result (ew-rcons*
  20                     result
  21                     (substring str i))))
  22     (apply 'concat (nreverse result))))
  23
  24 (defun ew-crlf-to-lf (str)
  25   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  26     (while (< j l-)
  27       (when (and (equal (aref str j) ?\r)
  28                  (equal (aref str (1+ j)) ?\n))
  29         (setq result (ew-rcons*
  30                       result
  31                       (substring str i j))
  32               j (1+ j)
  33               i j))
  34       (setq j (1+ j)))
  35     (when (< i l)
  36       (setq result (ew-rcons*
  37                     result
  38                     (substring str i))))
  39     (apply 'concat (nreverse result))))
  40
  41 (defun ew-lf-crlf-to-crlf (str)
  42   (let* ((i 0) (j 0) (l (length str)) (l- (1- l)) result)
  43     (while (< j l)
  44       (cond
  45        ((and (< j l-)
  46              (equal (aref str j) ?\r)
  47              (equal (aref str (1+ j)) ?\n))
  48         (setq j (1+ j)))
  49        ((equal (aref str j) ?\n)
  50         (setq result (ew-rcons*
  51                       result
  52                       (substring str i j)
  53                       "\r")
  54               i j)))
  55       (setq j (1+ j)))
  56     (when (< i l)
  57       (setq result (ew-rcons*
  58                     result
  59                     (substring str i))))
  60     (apply 'concat (nreverse result))))
  61
  62 (defun ew-crlf-unfold (str)
  63   (let* ((i 0) (j 0) (l (length str)) (l- (- l 2)) result)
  64     (while (< j l-)
  65       (when (and (equal (aref str j) ?\r)
  66                  (equal (aref str (1+ j)) ?\n)
  67                  (member (aref str (+ j 2)) '(?\t ?\ )))
  68         (setq result (ew-rcons*
  69                       result
  70                       (substring str i j))
  71               j (+ j 2)
  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-lf-unfold (str)
  81   (let* ((i 0) (j 0) (l (length str)) (l- (- l 1)) result)
  82     (while (< j l-)
  83       (when (and (equal (aref str j) ?\n)
  84                  (member (aref str (+ j 1)) '(?\t ?\ )))
  85         (setq result (ew-rcons*
  86                       result
  87                       (substring str i j))
  88               j (+ j 1)
  89               i j))
  90       (setq j (1+ j)))
  91     (when (< i l)
  92       (setq result (ew-rcons*
  93                     result
  94                     (substring str i))))
  95     (apply 'concat (nreverse result))))
  96
  97 (defun ew-cut-cr-lf (str)
  98   (let ((i 0) (j 0) (l (length str)) result)
  99     (while (< j l)
 100       (when (member (aref str j) '(?\r ?\n))
 101         (setq result (ew-rcons*
 102                       result
 103                       (substring str i j))
 104               i (1+ j)))
 105       (setq j (1+ j)))
 106     (when (< i l)
 107       (setq result (ew-rcons*
 108                     result
 109                     (substring str i))))
 110     (apply 'concat (nreverse result))))
 111
 112 (defmacro ew-line-generic-define ()
 113   (let ((str (make-symbol "str"))
 114         (others-fun (make-symbol "others-fun"))
 115         (fold-fun (make-symbol "fold-fun"))
 116         (crlf-fun (make-symbol "crlf-fun"))
 117         (bare-cr-fun (make-symbol "bare-cr-fun"))
 118         (bare-lf-fun (make-symbol "bare-lf-fun"))
 119         (p (make-symbol "p"))
 120         (q (make-symbol "q"))
 121         (r (make-symbol "r")))
 122     `(defun ew-line-generic
 123        (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
 124        (let ((,p 0) (,q (length ,str)) ,r)
 125          (while (< ,p ,q)
 126            (setq ,r ,p)
 127            (lex-scan-unibyte ,str ,p ,q
 128              ((+ [^ "\r\n"]) (when ,others-fun (funcall ,others-fun ,r ,p)))
 129              ((?\r ?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p)))
 130              ((?\r ?\n) (when ,crlf-fun (funcall ,crlf-fun ,r ,p)))
 131              ((?\r) (when ,bare-cr-fun (funcall ,bare-cr-fun ,r ,p)))
 132              ((?\n) (when ,bare-lf-fun (funcall ,bare-lf-fun ,r ,p)))
 133              (() (error "something wrong"))))
 134          ,q))))
 135
 136 (ew-line-generic-define)
 137
 138 (defmacro ew-line-convert-define ()
 139   (let ((str (make-symbol "str"))
 140         (others-fun (make-symbol "others-fun"))
 141         (fold-fun (make-symbol "fold-fun"))
 142         (crlf-fun (make-symbol "crlf-fun"))
 143         (bare-cr-fun (make-symbol "bare-cr-fun"))
 144         (bare-lf-fun (make-symbol "bare-lf-fun"))
 145         (index (make-symbol "index"))
 146         (result (make-symbol "result"))
 147         (start (make-symbol "starx"))
 148         (end (make-symbol "end")))
 149     `(defun ew-line-convert
 150        (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun)
 151        (let ((,index 0) ,result)
 152          (when (> (ew-line-generic
 153                       ,str
 154                     ,@(mapcar
 155                        (lambda (fun)
 156                          `(when ,fun
 157                             (lambda (,start ,end)
 158                               (when (< ,index ,start)
 159                                 (setq ,result
 160                                       (ew-rcons* ,result
 161                                                  (substring ,str ,index ,start))))
 162                               (setq ,result
 163                                     (ew-rcons* ,result
 164                                                (funcall ,fun
 165                                                         (substring ,str ,start ,end)))
 166                                     ,index ,end))))
 167                        (list others-fun fold-fun crlf-fun bare-cr-fun bare-lf-fun)))
 168                   ,index)
 169            (setq ,result
 170                  (ew-rcons* ,result
 171                             (substring ,str ,index))))
 172          (apply 'concat (nreverse ,result))))))
 173
 174 (ew-line-convert-define)