Added Stuff In

dir2org.org

@@ -0,0 +1,21 @@
+#+Title: dir2org
+#+AUTHOR: Sam Flint
+#+EMAIL: swflint@flintfam.org
+#+DATE: \today
+#+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js
+#+OPTIONS: toc:3 H:5 ':t *:t
+#+PROPERTY: noweb tangle
+#+LATEX_HEADER: \usepackage[color]{showkeys}
+
+* Imports
+#+Name: Imports
+#+BEGIN_SRC python
+  from os import listdir, getcwd
+  from os.path import isfile, isdir, islink
+#+END_SRC
+* Generate tree
+#+Name: GenTree
+#+BEGIN_SRC python
+  def gen_tree(directory):
+      for name in listdir(directory)
+#+END_SRC

isbn2bibtex.py

@@ -0,0 +1,54 @@
+#!/usr/bin/python
+# Copyright FlintFam Systems Management, 2013.
+# 
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+import sys
+import urllib
+import urllib2
+import json
+import random
+import re
+
+accesskey = "XXXXXXXX"
+jsonreq = "http://isbndb.com/api/v2/json/" + accesskey + "/books/?i=combined&q="
+
+qstring = ""
+for arg in sys.argv:
+    qstring = qstring + " " + arg
+
+query = urllib.quote_plus(qstring)
+queryURL = jsonreq + query
+jsondata = urllib2.urlopen(queryURL).read()
+data = json.loads(jsondata)
+
+for book in data['data']:
+    if book['author_data']:
+        authorid = book['author_data'][0]['id']
+        authorlast = re.split('_', authorid)
+        rand = random.randint(0, 3000)
+        bibtexkey = authorlast[0] + str(rand)
+        authoritem = ""
+        first = 1
+        for author in book['author_data']:
+            authorname = author['name']
+            if first == 0:
+                authoritem = authoritem + " and  " + authorname
+            else:
+                authoritem = authorname
+                first = 0
+        titleitem = book['title_latin']
+        publisher = book['publisher_name']
+        entry = "@Book{" + bibtexkey + ",\nauthor = \"{" + authoritem + "}\",\ntitle = \"{" + titleitem + "}\",\npublisher = \"{" + publisher + "}\"\n}\n\n"
+        print(entry)

mylisp.lisp

@@ -0,0 +1,48 @@
+(defun print-tag (name alst closingp)
+  (princ #\<)
+  (when closingp
+    (princ #\/))
+  (princ (string-downcase name))
+  (mapc (lambda (att)
+          (format t " ~a=\"~a\"" (string-downcase (car att)) (cdr att)))
+	alst)
+  (princ #\>))
+
+(defmacro let1 (var val &body body)
+  `(let ((,var ,val))
+     ,@body))
+
+(defmacro split (val yes no)
+  (let1 g (gensym)
+  `(let1 ,g ,val
+     (if ,g
+       (let ((head (car ,g))
+             (tail (cdr ,g)))
+         ,yes)
+         ,no))))
+
+
+(defun pairs (lst)
+    (labels ((f (lst acc)
+                (split lst
+                  (if tail
+                      (f (cdr tail) (cons (cons head (car tail)) acc))
+                      (reverse acc))
+                  (reverse acc))))
+      (f lst nil)))
+
+(defmacro tag (name atts &body body)
+  `(progn (print-tag ',name
+                     (list ,@(mapcar (lambda (x)
+                                       `(cons ',(car x) ,(cdr x)))
+                                     (pairs atts)))
+                     nil)
+          ,@body
+          (print-tag ',name nil t)))
+
+(defmacro svg (width height &body body)
+  `(tag svg (xmlns "http://www.w3.org/2000/svg" 
+             "xmlns:xlink" "http://www.w3.org/1999/xlink"
+             height ,height
+             width ,width)
+	,@body))

test-parser.lisp

@@ -0,0 +1,245 @@
+#-esrap (ql:quickload :esrap)
+
+(require :esrap)
+
+(defpackage #:test-parser
+  (:use :esrap
+        :cl)
+  (:export :display-parse-tree))
+
+(in-package :test-parser)
+
+(defvar *routines* (make-hash-table))
+(defvar *variables* (make-hash-table))
+(defvar *arrays* (make-hash-table))
+
+(defun not-doublequote (char)
+  (not (eql #\" char)))
+
+(defun not-integer (string)
+           (when (find-if-not #'digit-char-p string)
+             t))
+
+(defrule name
+    (+ (alphanumericp character))
+  (:text t))
+
+(defrule space
+    (+ (or #\Space #\Tab #\Newline))
+  (:constant nil))
+
+(defrule variable
+    (and "*v:" name)
+  (:destructure (vv name)
+                (declare (ignore vv))
+                (list :variable name)))
+
+(defrule string-char
+    (or (not-doublequote character)
+        (and #\\ #\")))
+
+(defrule string
+    (and #\" (* string-char) #\")
+  (:destructure (q1 string q2)
+                (declare (ignore q1 q2))
+                (list :string (text string))))
+
+(defrule number
+    (+ (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
+  (:lambda (list)
+    (list :number (parse-integer (text list)))))
+
+(defrule call-routine
+    (and "*r:" name  "(" (? val-list) ")")
+  (:destructure (call-syntax name lpar vals rpar)
+                (declare (ignore call-syntax lpar rpar))
+                (list 'handle-call-routine name vals)))
+
+(defrule val-list
+    (+ (or possible-value ", "))
+  (:destructure (&rest vals)
+                (let ((list '(:val-list)))
+                  (dolist (value vals)
+                    (if (not (stringp value))
+                        (push value list)))
+                  (reverse list))))
+
+(defrule possible-value
+    (or string variable number call-routine builtins array array-in))
+
+(defrule assignment
+    (and (or variable array)
+         (? space)
+         #\=
+         (? space)
+         possible-value)
+  (:destructure (var s1 eqlsgn s2 value)
+                (declare (ignore s1 eqlsgn s2))
+                (list 'handle-assignment var value)))
+
+
+(defrule builtins
+    (and (or "out" "in" "system" "open" "close" "return" "argument" "random") "(" val-list ")")
+  (:destructure (name start vals end)
+                (declare (ignore start end))
+                (list
+                 (cond
+                   ((string= name "out")
+                    'do-out)
+                   ((string= name "in")
+                    'do-in)
+                   ((string= name "system")
+                    'do-system)
+                   ((string= name "open")
+                    'do-open)
+                   ((string= name "close")
+                    'do-close)
+                   ((string= name "return")
+                    'do-return)
+                   ((string= name "argument")
+                    'do-argument)
+                   ((string= name "random")
+                    'do-random))
+                 vals)))
+
+(defrule arith-ops
+    (or "+" "-" "*" "/" "%" "^")
+  (:lambda (operator)
+    (cond
+      ((string= operator "+") :PLUS)
+      ((string= operator "-") :SUBT)
+      ((string= operator "*") :MULT)
+      ((string= operator "/") :DIVD)
+      ((string= operator "%") :MODU)
+      ((string= operator "^") :EXPT))))
+
+
+(defrule arithmetic
+    (or (and (? "(") (? space) arithmetic (? space) arith-ops (? space) arithmetic (? space) (? ")"))
+        (or variable number))
+  (:destructure (first second &optional aritha mspace op mmspace arithb mmmspace rpar)
+                (if (symbolp first)
+                    (list (list first second))
+                    (list :ARITH
+                          op
+                          aritha
+                          arithb))))
+
+(defrule index
+    (and ":" possible-value ":")
+  (:destructure (s val e)
+                (declare (ignore s e))
+                val))
+
+(defrule array
+    (and "*a:" name (? index))
+  (:destructure (va name index)
+                (declare (ignore va))
+                (list :ARRAY name index)))
+
+(defrule array-in
+    (and "<" val-list ">")
+  (:destructure (s vals e)
+                (declare (ignore s e))
+                (list :aval vals)))
+
+
+;; rest goes here
+
+(defrule boolean
+    (and variable (? space) (or "==" "!=" ">" "<" ">=" "<=") (? space) possible-value)
+  (:destructure (variable s1 type s2 value)
+                (declare (ignore s1 s2))
+                (list :boolean variable type value)))
+
+(defrule bool-name
+    (or "AND" "NOT" "OR" "NOR")
+  (:lambda (name)
+                (cond
+                  ((string= name "AND")
+                   :AND)
+                  ((string= name "NOT")
+                   :NOT)
+                  ((string= name "OR")
+                   :OR)
+                  ((string= name "NOR")
+                   :NOR))))
+
+(defrule statement
+    (and (? space)
+         (or assignment call-routine builtins)
+         (? space) #\; (? space))
+  (:destructure (space1 statement space2 semicolon space3)
+                (declare (ignore semicolon space1 space2 space3))
+                statement))
+
+(defrule block
+    (* statement)
+  (:destructure (&rest statements)
+                (list :block statements)))
+
+(defrule else
+    (and "ELSE:" space block)
+  (:destructure (name space block)
+                (declare (ignore name space))
+                (list :ELSE block)))
+
+(defrule else-if
+    (and "ELSE-IF" space boolean #\: block)
+  (:destructure (start space bool colon block)
+                (declare (ignore start space colon))
+                (list :ELSEIF bool block)))
+
+(defrule if
+    (and "IF" space boolean #\: space
+         block
+         (* (or else else-if))
+         "ENDIF")
+  (:destructure (start space bool colon morespace block else-else-ifs end)
+                (declare (ignore start space colon morespace end))
+                (list :IF bool block else-else-ifs)))
+
+(defrule routine
+    (and "ROUTINE" (? space) name #\:
+         block
+         "END-ROUTINE")
+  (:destructure (rtn spc1 name colon block end-rtn)
+                (declare (ignore rtn spc1 colon end-rtn))
+                (list :routine name block)))
+(defrule program
+    (* (or statement if routine)))
+
+(defun run-string (string)
+  (run-program (parse 'program string)))
+
+(defun run-program (program-list)
+  (dolist (chunk program-list)
+    (let ((type (car chunk)))
+      (cond
+        ((eq type :call-routine)
+         (handle-call-routine chunk))
+        ((eq type :assignment)
+         (handle-assignment chunk))
+        ((eq type :builtins)
+         (handle-builtins chunk))
+        ((eq type :block)
+         (run-program (cdr chunk)))
+        ((eq type :routine)
+         (handle-routine chunk))
+        ((eq type :if)
+         (handle-if chunk))))))
+
+(defun handle-call-routine (list))
+(defun handle-assignment (list))
+(defun handle-builtins (list))
+(defun handle-routine (list)
+  (let ((routine-name (cadr list))
+        (routine (caddr list)))
+    (setf (gethash (intern routine-name) *routines*) routine)))
+(defun handle-if (list))
+(defun set-variable (name value))
+(defun set-whole-array (name vil value))
+(defun set-array-indexed (name index values))
+
+(defun display-parse-tree (string)
+  (parse 'program string))