git.fiddlerwoaroof.com
tools/git-pick-patch.lisp
7c37909c
 (defpackage :git-pick-patch
   (:use :cl :alexandria :serapeum)
   (:export ))
 (in-package :git-pick-patch)
 
 (defun read-header (inp)
   (string-join (loop for line = (read-line inp nil)
                   while line
                   collect line
                   until (eql #\@ (peek-char nil inp nil)))
                #\newline))
 
 (defun read-hunk (inp)
   (when (eql #\@
              (peek-char nil inp nil))
     (string-join (loop for line = (read-line inp nil)
                     while line
                     collect line
                     until (member (peek-char nil inp nil) '(#\@ #\d)))
                  #\newline)))
 
 (defun read-hunks (inp)
   (loop for hunk = (read-hunk inp)
      while hunk
      collect hunk))
 
 (defun get-file-patch (inp)
   (list (read-header inp)
         (read-hunks inp)))
 
 (defun get-all-patches (inp)
   (loop for patch = (get-file-patch inp)
      for (header data) = patch
      while (and (string/= header "")
                 (not (null data)))
      collect patch))
 
 (defun filter-hunks (hunks predicate)
   (remove-if-not predicate hunks))
 
 (defun filter-file-hunks (file-data predicate)
   (let ((results (filter-hunks (cadr file-data)
                                predicate)))
     (when results
       (list (car file-data)
             results))))
 
 (defun filter-patch (patch-data predicate)
   (remove-if #'null (mapcar (lambda (x)
                               (filter-file-hunks x predicate))
                             patch-data)))
 
 (defun combine-hunks (hunks)
   (string-join hunks #\newline))
 
 (defun rebuild-file-patch (file-data)
   (destructuring-bind (header hunks) file-data
     (format nil "~a~%~a" header (combine-hunks hunks))))
 
 (defun rebuild-patch (patch-data)
   (string-join (mapcar #'rebuild-file-patch patch-data)
                #\newline))
 
 (defun main ()
   (if (null (cadr sb-ext:*posix-argv*))
       (format t "~&Must provide a pattern!")
       (let* ((pattern (cadr sb-ext:*posix-argv*)))
         (loop for patch = (get-file-patch *standard-input*)
            for filtered = (when patch (filter-file-hunks patch
                                                          (op (cl-ppcre:scan pattern _))))
            until (equal patch '("" nil))
            when filtered do
              (format t "~&~a~&" (rebuild-file-patch filtered))))))