# HG changeset patch # User Steve Losh # Date 1607813049 18000 # Node ID c5f79f4ca83c43aa5aaaee90bb9e57fc4c1766e6 # Parent b0694cb7f7336012e0fd47fc8d4b1e2bf7f2296e# Parent 38f572e1b19b3e2e066c27b6d3b38ec00b22dea6 Merge diff -r b0694cb7f733 -r c5f79f4ca83c lisp/search.lisp --- a/lisp/search.lisp Sat Dec 12 17:43:54 2020 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -(eval-when (:compile-toplevel :load-toplevel :execute) - (ql:quickload '(:adopt :cl-ppcre :with-user-abort) :silent t)) - -(defpackage :search - (:use :cl) - (:export :toplevel :*ui*)) - -(in-package :search) - -;;;; Functionality ------------------------------------------------------------ -(defun make-scanner (pattern &key literal) - (let ((ppcre:*use-bmh-matchers* t) - (ppcre:*optimize-char-classes* :charmap) - (ppcre:*regex-char-code-limit* 128)) - (ppcre:create-scanner (if literal - `(:sequence ,pattern) - (ppcre:parse-string pattern))))) - -(defun search-stream (scanner stream &key invert) - (loop - :for line = (read-line stream nil nil nil) - :while line - :when (eq invert (not (ppcre:scan scanner line))) - :do (write-line line))) - -(defun search-file (scanner path &key invert) - (with-open-file (stream path :external-format '(:ascii :replacement #\?)) - (search-stream scanner stream :invert invert))) - -(defun run (pattern paths &key literal invert) - (loop - :with scanner = (make-scanner pattern :literal literal) - :for path :in paths - :do (if (string= "-" path) - (search-stream scanner *standard-input* :invert invert) - (search-file scanner path :invert invert)))) - - -;;;; CLI ---------------------------------------------------------------------- -(adopt:define-string *documentation* - "A simple reimplementation of grep in Common Lisp. FILEs will be searched ~ - for lines that match PATTERN and matching lines will be printed.~@ - ~@ - Perl-compatible regular expressions are supported.~@ - ~@ - If no FILEs are given, standard input will be searched. Standard input can ~ - also be searched by specifying - as a filename.") - - -(defparameter *ui* - (adopt:make-interface - :name "search" - :usage "PATTERN [FILE...]" - :summary "Print lines that match a regular expression." - :help *documentation* - :contents - (list - (adopt:make-option 'help - :help "display help and exit" - :long "help" - :short #\h - :reduce (constantly t)) - (adopt:make-option 'literal - :help "treat PATTERN as a literal string instead of a regex" - :long "literal" - :short #\l - :reduce (constantly t)) - (adopt:make-option 'no-literal - :result-key 'literal - :help "treat PATTERN as a regex (the default)" - :long "no-literal" - :short #\L - :reduce (constantly nil)) - (adopt:make-option 'invert - :help "print non-matching lines" - :long "invert" - :short #\v - :initial-value nil - :reduce (constantly t)) - (adopt:make-option 'no-invert - :result-key 'invert - :help "print matching lines (the default)" - :long "no-invert" - :short #\V - :reduce (constantly nil))))) - -(defun toplevel () - (handler-case - (with-user-abort:with-user-abort - (multiple-value-bind (arguments options) (adopt:parse-options *ui*) - (when (gethash 'help options) - (adopt:print-help-and-exit *ui*)) - (when (null arguments) - (error "PATTERN is required")) - (destructuring-bind (pattern . paths) arguments - (run pattern (or paths (list "-")) - :literal (gethash 'literal options) - :invert (gethash 'invert options))))) - (with-user-abort:user-abort () (adopt:exit 130)) - (error (c) (adopt:print-error-and-exit c))))