2898f6fe4376

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/git-man-pages.lisp	Thu Jan 12 16:28:29 2017 +0000
@@ -0,0 +1,220 @@
+(in-package :chancery)
+(named-readtables:in-readtable :chancery)
+
+(define-rule noun
+  "binary blob"
+  "packfile"
+  "refspec"
+  "blob"
+  "branch"
+  "changeset"
+  "commit"
+  "conflicted merge"
+  "current HEAD"
+  "file"
+  "head"
+  "merge"
+  "remote"
+  "object"
+  "patch"
+  "ref"
+  "repository"
+  "symlink"
+  "tag"
+  "tip"
+  )
+
+
+(define-rule git-location%
+  "repository"
+  "index"
+  "working tree"
+  "content-addressable filesystem"
+  "object store"
+  "reflog"
+  "current directory"
+  "current repository"
+  "current branch"
+  "checked-out branch"
+  "upstream repository"
+  "DAG")
+
+(define-rule git-folder%
+  ""
+  "refs"
+  "logs"
+  "objects"
+  "hooks"
+  "HEAD"
+  "COMMIT_EDITMSG")
+
+(define-rule git-folder
+  (".git/" :. git-folder%))
+
+(define-rule git-location
+  ("the" git-location%)
+  git-folder)
+
+(define-rule external-location
+  "Hacker News"
+  "Stack Overflow"
+  "Twitter"
+  "Reddit"
+  "Github"
+  "Gitlab"
+  "Github's status page"
+  "/dev/random"
+  "/dev/urandom"
+  "your .gitconfig"
+  "the git man pages"
+  "the git source code"
+  "your home directory")
+
+(define-rule location
+  git-location
+  external-location)
+
+
+(define-rule action
+  (list "bisect" "bisecting")
+  (list "clone" "cloning")
+  (list "commit" "committing")
+  (list "delete" "deleting")
+  (list "display" "displaying")
+  (list "fast-forward" "fast-forwarding")
+  (list "fetch" "fetching")
+  (list "merge" "merging")
+  (list "move" "moving")
+  (list "print" "printing")
+  (list "prune" "pruning")
+  (list "pull" "pulling")
+  (list "push" "pushing")
+  (list "record" "recording")
+  (list "revert" "reverting")
+  (list "remove" "removing")
+  (list "rename" "renaming")
+  (list "reset" "resetting")
+  (list "resolve" "resolving")
+  (list "show" "showing")
+  (list "sign" "signing")
+  (list "simplify" "simplifying")
+  (list "update" "updating")
+  (list "verify" "verifying")
+  )
+
+(defun action-verb ()
+  (first (action)))
+
+
+(define-rule refresh
+  "update"
+  "reset")
+
+(define-rule refreshing
+  "updating"
+  "resetting")
+
+
+(define-rule extremum
+  "newest"
+  "oldest"
+  "largest"
+  "smallest"
+  "sparsest"
+  "first"
+  "last"
+  "worst"
+  "simplest"
+  "best")
+
+(define-rule adjective
+  "merged"
+  "unmerged"
+  "symbolic"
+  "uncommitted"
+  "signed"
+  "unsigned"
+  "big-endian"
+  "little-endian"
+  "childless"
+  "binary"
+  )
+
+
+(define-rule age
+  "newest"
+  "oldest"
+  "first"
+  "last")
+
+(define-rule look-for
+  "search"
+  "grep"
+  "bisect"
+  "filter")
+
+(define-rule temporal-adverb
+  "before"
+  "after"
+  "without")
+
+
+(defun letter ()
+  (random-elt "abcdefghijklmnopqrstuvwxyz"))
+
+(defun shellify (str)
+  (string-downcase (substitute #\- #\space str)))
+
+(define-rule short-option%
+  ("-" :. letter)
+  ("-" :. letter [noun shellify string-upcase]))
+
+(define-rule long-option%
+  (bind ((noun [noun shellify]))
+    ("--" :. noun :. "=<" :. noun :. ">"))
+  ("--" :. action-verb)
+  ("--" :. extremum)
+  ("--only-" :. adjective)
+  ("--only-" :. [noun shellify s])
+  ("--" :. action-verb :. "=<" :. [noun shellify] :. ">"))
+
+(define-rule short-option
+  short-option%
+  ("[" :. short-option% :. "]"))
+
+(define-rule long-option
+  long-option%
+  ("[" :. long-option% :. "]"))
+
+(define-rule short-options
+  short-option
+  (short-option short-option))
+
+(define-rule options
+  long-option
+  short-options
+  (short-options long-option)
+  (long-option short-options))
+
+
+(define-rule description
+  (look-for location "for the" age noun "and" command "it")
+  ("read" (eval (+ 2 (random 2000))) "bytes from" location "and" command "them")
+  (command "the" extremum noun "in" git-location)
+  (command [noun a] temporal-adverb refreshing git-location)
+  (command "and push all" adjective [noun s] "to" location)
+  (command "all" adjective [noun s] "in" git-location)
+  (command "the" extremum "and merge it into" git-location)
+  (command "some" [noun s] "from a remote")
+  (command "two or more" [noun s] "and save them to" location)
+  ("move or" command [noun a] "in" git-location)
+  ("rebase" [noun a] "onto" location "after" commanding "it")
+  (command "and" refresh git-location)
+  ("list," command :. ", or delete" [noun s]))
+
+
+(define-rule entry
+  (bind (((command commanding) action))
+    ("git" command options #\newline :. [description cap])))
+
+

--- a/src/chancery.lisp	Thu Jan 12 11:14:27 2017 +0000
+++ b/src/chancery.lisp	Thu Jan 12 16:28:29 2017 +0000
@@ -182,6 +182,13 @@
     ((#\z #\h) (cat (chop string 1) "es"))
     (t (cat string "s"))))
 
+(defun ing (string)
+  "Add ing to `string`."
+  (assert-nonempty string "Cannot add ing to an empty string.")
+  (if (eql #\e (ch string -1))
+    (cat (chop string 1) "ing")
+    (cat string "ing")))
+
 (defun pos (string)
   "Make `string` posessive by adding an apostrophe (and possibly an s)."
   (assert-nonempty string "Cannot make an empty string posessive.")