git.fiddlerwoaroof.com
lexer-main.php
85d5b584
 (in-package :php.lexer)
 
 (eval-when (:compile-toplevel :execute :load-toplevel)
   (ql:quickload :osicat)
   (osicat-posix:setenv "CC" "clang") 
   (ql:quickload :net.didierverna.clon))
 
 (net.didierverna.clon:defsynopsis (:postfix "PHP-FILE")
   (text :contents "lex and dump the lexical structure of a php file")
   (flag :short-name "t" :long-name "tokens-only"
 	:description "Show only tokens")
   (flag :short-name "r" :long-name "show-remainder"
 	:description "Show leftovers after parsing")
   (flag :short-name "h" :long-name "help"
 	:description "Show this help"))
 
 
 ;; (defsynopsis (:postfix "TIMESHEETS ...")
 ;;   (text :contents "A program for managing logs of hours worked")
 ;;   (group (:header "Display options")
 ;;          (flag :short-name "s" :long-name "status"
 ;;                :description "Print a short summary of work status")
 ;;          (flag :short-name "W"
 ;;                :long-name "ignore-whitespace"
 ;;                :description "Ignore whitespace errors in input")
 ;;          (flag :short-name "i" :long-name "interactive"
 ;;                :description "Run interactively"))
 ;;   (group (:header "Sort options")
 ;;          (flag :short-name "r"
 ;;                :long-name "reverse"
 ;;                :description "Reverse the sort direction")
 ;;          (flag :short-name "c"
 ;;                :long-name "client"
 ;;                :description "Sort records by client") 
 ;;          (flag :short-name "dr"
 ;;                :long-name "daily-report"
 ;;                :description "Print a daily report for the passed logs"))
 ;;   (group (:header "Freshbooks")
 ;;          (flag :long-name "post-hours"
 ;;                :description "Post hours to freshbooks (requires manual setup of Freshbooks keys)"))
 ;;   (group (:header "Self-test options")
 ;;          (flag :long-name "dependencies"
 ;;                :description "Graph the dependencies of this project")
 ;;          (flag :long-name "run-tests"
 ;;                :description "Run the tests")
 ;;          (enum :long-name "output-style"
 ;;                :description "The kind of output to produce"
 ;;                :default-value :normal
 ;;                :enum '(:xunit :normal)))
 ;;   (group (:header "Reformat options")
 ;;          (flag :long-name "reformat-file"
 ;;                :short-name "f"
 ;;                :description "Read the current timesheet file and dump, correcting any whitespace or formatting errors"))
 ;;   (group (:header "Generic options")
 ;;          (flag :short-name "v" :long-name "version"
 ;;                :description "Show the program version")
 ;;))
 
 ;; (defun pprint-log-main ()
 ;;   (net.didierverna.clon:make-context)
 ;;   (tagbody
 ;;     start
 ;;     (restart-case
 ;;       (cond
 ;;         ((getopt :long-name "help") (help))
 ;;         ((getopt :long-name "version") (show-version))
 ;;         ((getopt :long-name "dependencies") (format t (tempores.package-grapher::graph-tempores-packages)))
 ;;         ((getopt :long-name "post-hours") (let ((*print-pretty* nil))
 ;;                                             (loop for item in (tempores.freshbooks::post-time-entries-main)
 ;;                                                   do (format t "Posted an entry")
 ;;                                                   do (plump:serialize item)
 ;;                                                   finally (format t "Don't forget to archive time file."))))
 ;;         ((getopt :long-name "run-tests") (tests-main (getopt :long-name "output-style")))
 ;;         ((getopt :long-name "reformat-file") (reformat-main))
 ;;         ((getopt :long-name "daily-report") (print-daily-report (remainder)))
 ;;         (t (with-tempores-configuration ()
 ;;              (pprint-log
 ;;                (remainder)
 ;;                :client (getopt :long-name "client")
 ;;                :interactive (getopt :long-name "interactive")
 ;;                :ignore-whitespace (getopt :long-name "ignore-whitespace")
 ;;                :status (getopt :long-name "status")
 ;;                :reverse (getopt :long-name "reverse")))))
 ;;       (retry () (go start))
 ;;       (abort ()))))
 
 (defun main ()
   (net.didierverna.clon:make-context)
   (cond
     ((net.didierverna.clon:getopt :long-name "help") (net.didierverna.clon:help))
     (t (let* ((*print-pretty* t)
 	      (*print-right-margin* 80)
 	      (tokens-only (net.didierverna.clon:getopt :long-name "tokens-only"))
 	      (show-remainder (net.didierverna.clon:getopt :long-name "show-remainder")))
 	 (multiple-value-bind (result leftovers)
 	     (parse (.input-file)
 		    (slurp-file (car (net.didierverna.clon:remainder))))
 	   (when tokens-only
 	     (setf result (remove-if-not (lambda (x) (eq x :token))
 					 result :key #'car))) 
 	   
 	   (print result)
 	   (when show-remainder
 	     (fresh-line)
 	     (terpri)
 	     (print leftovers)))))))
 
 (defun make-executable ()
   (net.didierverna.clon:dump "php-lex" main
         :compression 8
         :purify t))