Permalink
Browse files

sed が使えないので。

  • Loading branch information...
0 parents commit 2c2f1c8d85875dc005a3e3bd1263905903341b46 @quek committed Jan 25, 2012
Showing with 77 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +8 −0 info.read-eval-print.sed.asd
  3. +5 −0 package.lisp
  4. +62 −0 sed.lisp
@@ -0,0 +1,2 @@
+*~
+*.fasl
@@ -0,0 +1,8 @@
+;;;; -*- Mode: LISP; -*-
+(asdf:defsystem :info.read-eval-print.sed
+ :version "0.0.0"
+ :serial t
+ :components ((:file "package")
+ (:file "sed"))
+ :depends-on (info.read-eval-print.series-ext
+ cl-ppcre))
@@ -0,0 +1,5 @@
+(cl:in-package :cl)
+
+(info.read-eval-print.series-ext:sdefpackage :info.read-eval-print.sed
+ (:use :cl))
+
@@ -0,0 +1,62 @@
+(in-package :info.read-eval-print.sed)
+
+(defvar *sed* nil)
+
+(defstruct sed
+ (in *standard-input*)
+ (out *standard-output*)
+ hold-space
+ pattern-space
+ (line-numebr 0))
+
+(define-symbol-macro *pattern-space* (sed-pattern-space *sed*))
+
+(defun s (pattern replacement &rest options)
+ (let ((pattern (ppcre:create-scanner pattern :case-insensitive-mode (member :i options))))
+ (setf *pattern-space*
+ (apply (if (member :g options)
+ #'ppcre:regex-replace-all
+ #'ppcre:regex-replace)
+ pattern *pattern-space* replacement nil))))
+
+(defun c (text)
+ (setf *pattern-space* text))
+
+(defmacro ? (address-or-address1-and-2 &body body)
+ `(when (ppcre:scan ,address-or-address1-and-2 *pattern-space*)
+ ,@body))
+
+(defmacro sed ((&key (in *standard-input*) (out *standard-output*)) &body body)
+ (let* ((in-var (gensym "in"))
+ (out-var (gensym "out"))
+ (form `(let ((*sed* (make-sed :in ,in-var :out ,out-var)))
+ (tagbody
+ :next
+ (unless (setf *pattern-space* (read-line (sed-in *sed*) nil))
+ (go :end))
+ ,@body
+ (write-line *pattern-space* (sed-out *sed*))
+ (go :next)
+ :end))))
+ `(cond ((and (not (streamp ,in))
+ (not (streamp ,out)))
+ (with-open-file (,in-var ,in)
+ (with-open-file (,out-var ,out :direction :output :if-exists :supersede)
+ ,form)))
+ ((not (streamp ,in))
+ (with-open-file (,in-var ,in)
+ (let ((,out-var ,out))
+ ,form)))
+ ((not (streamp ,out))
+ (let ((,in-var ,in))
+ (with-open-file (,out-var ,out :direction :output :if-exists :supersede)
+ ,form)))
+ (t
+ (let ((,in-var ,in)
+ (,out-var ,out))
+ ,form)))))
+
+(sed (:in "~/.zshrc")
+ (? "HIS"
+ (c "---------------------------- HIS"))
+ (s "setopt" "FOO"))

0 comments on commit 2c2f1c8

Please sign in to comment.