git.fiddlerwoaroof.com
Raw Blame History
(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))