What is the fastest way to read a csv file in CL in a way such that:
1) all fields in the first line go into one array called column-names
2) the first field of each of all following lines goes into another
array called row-names
3) all other fields go into another array called values
?
My file has the following form, just with a lot more columns and rows:
"";"ES1 Index";"VG1 Index";"TY1 Comdty";"RX1 Comdty";"GC1 Comdty"
"1999-01-04";1391.12;3034.53;66.515625;86.2;441.39
"1999-01-05";1404.86;3072.41;66.3125;86.17;440.63
"1999-01-06";1435.12;3156.59;66.4375;86.32;441.7
"1999-01-07";1432.32;3106.08;66.25;86.22;447.67
And the result I would like is:
#("1999-01-04" "1999-01-05" "1999-01-06" "1999-01-07" )
#("" "ES1 Index" "VG1 Index" "TY1 Comdty" "RX1 Comdty" "GC1 Comdty")
#(1391.12 3034.53 66.515625 86.2 441.39 1404.86 3072.41 66.3125 86.17 440.63
1435.12 3156.59 66.4375 86.32 441.7 1432.32 3106.08 66.25 86.22 447.67)
Are you aware of some CL library that does so already?
Are there any general issues regarding I/O performance, maybe compiler-specific, that I should be aware of?
Here is the way I am doing it now:
(with-open-file (stream "my-file.csv" :direction :input)
(let* ((header (read-line stream nil))
(columns-list (mapcar #'read-from-string
(cl-ppcre:split ";" header)))
(number-of-columns (length columns-list))
(column-names (make-array number-of-columns
:initial-contents columns-list))
(rownames (make-array 1 :adjustable t :fill-pointer 0))
(values (make-array 1 :adjustable t :fill-pointer 0)))
(set-syntax-from-char #\; #\ )
(loop
:for reader = (read stream nil stream)
:until (eq reader stream)
:do (progn (vector-push-extend reader row-names)
(loop
:for count :from 2 :upto number-of-columns
:do (vector-push-extend (read stream nil)
values)))
:finally (return (values row-names
column-names
values)))))
Note: I wouldn't use set-syntax-from-char in real code, I am using it just for the sake of this example.
I suspect that the I/O is the slowest part here. You can probably get faster I/O if you use READ-SEQUENCE rather than calling READ-LINE repeatedly. So your code might look something like this:
(with-open-file (s "my-file.csv")
(let* ((len (file-length s))
(data (make-array len)))
(read-sequence data s)
data))
Then split data by newlines and add your logic.
Whether that helps or not, it'd helpful for you to profile your code, e.g. with :sb-sprof, to see where most of the time is being spent.
To read csv files, I find very useful and fast the cl-csv package (https://github.com/AccelerationNet/cl-csv). For instance, to solve your problem, the following code could be used:
(let ((data (cl-csv:read-csv #P"my-file.csv" :separator #\;)))
(values (apply #'vector (first data))
(apply #'vector (rest (mapcar #'first data)))
(apply #'vector
(mapcar #'read-from-string (loop :for row :in (rest data)
:append (rest row))))))
cl-csv:read-csv returns a list contaning, for each row, a list of strings that are the contents of the cells.
Related
For a course project I got to write a program in lisp.
The program should contain the most important lisp functions, their input and output parameters and maybe optional parameters.
For example: function - first, input - list, output - object (first member of list).
The program should work in 2 different ways:
You give the program the name of a function and it should return the function parameters.
You enter function parameters and if a function with these parameters exists, it should return the name of the function.
My questions:
What would be the right way to approach a task like this in lisp? I think maybe a tree would be a way to handle it? (make a tree with all functions and parameters and then write a program which handles it).
Does anyone have a better idea than that to approach this task? Or some suggestions where / how to start? Or Tutorials containing any info?
At the moment I'm a little lost how to start. Any help you can give would be highly appreciated.
English isn't my first language, so I hope everything is understandable.
Greetings.
First of all take a look to prepare your common lisp development environment. After that I think that you should, investigate:
create functions with defun,
declare types.
and things like that. Ffter that take a look to two common lisp functions:
documentation
describe
Here is a little example:
CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (+ a b))
MY-SUM
CL-USER> (my-sum 2 3)
5 (3 bits, #x5, #o5, #b101)
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (T T) (VALUES NUMBER &OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
"Add my-sum parameters A and B."
(BLOCK MY-SUM (+ A B)))
; No values
CL-USER> (documentation 'my-sum 'function)
"Add my-sum parameters A and B."
CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (declare (type fixnum a b)) (+ a b))
WARNING: redefining COMMON-LISP-USER::MY-SUM in DEFUN
MY-SUM
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
(VALUES
(INTEGER -9223372036854775808 9223372036854775806)
&OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
"Add my-sum parameters A and B."
(DECLARE (TYPE FIXNUM A B))
(BLOCK MY-SUM (+ A B)))
; No values
Finally, one last tip to work with strings from the output of describe:
CL-USER> (with-output-to-string (*standard-output*)
(describe #'my-sum))
"#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
(VALUES
(INTEGER -9223372036854775808 9223372036854775806)
&OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
\"Add my-sum parameters A and B.\"
(DECLARE (TYPE FIXNUM A B))
(BLOCK MY-SUM (+ A B)))
"
At face value, the task seems to be the construction of a simple symbolic database in memory, which is searchable in two ways. Entries in the database are understood to be functions. The "output parameters" can probably be understood as one or more return values. These things are not named in ANSI Lisp. A useful interpretation of the task is to give return values symbolic labels anyway. Moreover, we can perhaps use type symbols for the return values as well as parameters. So for instance, a database entry for the cons function might look like:
(cons (t t) cons) ;; function named cons takes two objects, returns a cons
The type t is the supertype of all types in ANSI Lisp; it means "any value".
A list of such records can be put into some global variable. Then we write a function that is perhaps named get-params-by-name such that:
(get-params-by-name 'cons) -> (t t)
and another one: get-names-by-params:
(get-names-by-params '(t t)) -> (cons)
This function returns all the matching functions, as a list. More than one function could have this signature.
The trick is then finding a good representation of optional and rest parameters. It could just be the same notation that the language uses:
(list (&rest t) list) ;; list takes rest arguments of any type, returns list
Since we are only interested in exact matches, we don't have to actually parse the &rest notation. When the user queries by parameter, their query object will be literally (&rest t), in that same syntax.
The equal function can be used to tell whether two lists of symbols are identical:
(equal '(&rest t) '(&rest t)) -> t
(equal '(t t) '(t t)) -> nil
So the exercise is not difficult: just mapping through lists, looking for matches.
(defun get-name-by-params (database params)
(let ((matching-entries (remove-if-not (lambda (entry)
(equal (second entry) params))
database)))
(mapcar #'first matching-entries))) ;; just the names, please
Here, the function takes the database list as a parameter, instead of referring to a global variable. The overall program into which we integrate this can provide alternative interfaces, but this is our low-level lookup function.
Test:
[1]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(integer string))
NIL
[3]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(t t))
(CONS)
[4]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(&rest t))
(LIST)
I'd get clarification from the instructor whether this is the right interpretation of the vague requirements, before the assignment is due.
Given that this is a course project I'm going to provide an incomplete answer, and leave you to fill in the blanks.
What the program should do
My interpretation of what you're being asked to do is to provide a utility which will
given the name of a function return its argument list (called a 'lambda list' below);
given a lambda list return all the functions with that lambda list.
So, first of all you need to decide whether two lambda lists are the same or not. As an example is (x) the same as (y), as a lambda list? Yes, it is: the names of formal parameters only matter in the implementation of a function and you generally won't know them: both of these lambda lists mean 'function of one argument'.
The interestring thing is optional arguments of various kinds: (a &optional b) is clearly not the same as (a), but is the same as (b &optional c) but is it the same as (a &optional (b 1 bp))? In this code I say that yes, it is the same: default values and present parameters for optional arguments don't alter whether lambda lists are the same. That's because very often these are implementation details of functions.
A package
We'll put it into a package so it's clear what the interface is:
(defpackage :com.stackoverflow.lisp.fdesc-search
(:use :cl)
(:export
#:defun/recorded
#:record-function-description
#:clear-recorded-functions
#:name->lambda-list
#:lambda-list->names))
(in-package :com.stackoverflow.lisp.fdesc-search)
Recording information
So, to start with we need a mechanism of recording information about functions. We'll do this with a macro which is like defun but records information, which I'll call defun/recorded. We want to be able to record information about things even before the program exists & we do this by having defun/recorded stash 'pending' records on a list which, once the program exists, it will pull off and record properly. That lets us use defun/recorded throughout this code.
;;; These define whether there is a recorder, and if not where pending
;;; records should be stashed
;;;
(defvar *function-description-recorder* nil)
(defvar *pending-function-records* '())
(defmacro defun/recorded (name lambda-list &body forms)
"Like DEFUN but record function information."
;; This deals with bootstrapping by, if there is not yet a recording
;; function, stashing pending records in *PENDING-FUNCTION-RECORDS*,
;; which gets replayed into the recorder at the point it becomes
;; available.
`(progn
;; do the DEFUN first, which ensures that the LAMBDA-LIST is OK
(defun ,name ,lambda-list ,#forms)
(if *function-description-recorder*
(progn
(dolist (p (reverse *pending-function-records*))
(funcall *function-description-recorder*
(car p) (cdr p)))
(setf *pending-function-records* '())
(funcall *function-description-recorder*
',name ',lambda-list))
(push (cons ',name ',lambda-list)
*pending-function-records*))
',name))
Matching lambda lists, first steps
Now we want to be able to match lambda lists. Since we're obviously going to store things indexed by lambda list in some kind of tree we only really need to be able to deal with matching elements of them. And (see above) we don't care about things like default values. I've chosen to do this by first of all simplifying lambda lists to remove them and then matching the simplifies elements: there are other approaches.
simplify-lambda-list does the simplification and argument-matches-p tells you if two arguments match: the interesting bit is that it needs to know about lambda list keywords, which must match exactly, while everything else matches anything. The lambda-list-keywords constant is conveniently provided by the CL standard.
(defun/recorded simplify-lambda-list (ll)
;; Simplify a lambda list by replacing optional arguments with inits
;; by their names. This does not validate the list
(loop for a in ll
collect (etypecase a
(symbol a)
(list (first a)))))
(defun/recorded argument-matches-p (argument prototype)
;; Does an argument match a prototype.
(unless (symbolp argument)
(error "argument ~S isn't a symbol" argument))
(unless (symbolp prototype)
(error "prototype ~S isn't a symbol" prototype))
(if (find-if (lambda (k)
(or (eq argument k) (eq prototype k)))
lambda-list-keywords)
(eq argument prototype)
t))
Function descriptions (partial)
Information about functions is stored in objects called fdescs: the definition of these objects is not given here, but one question we need to answer is 'do two fdescs refer to versions of the same function?' Well, they do if the names of the functions are the same. Remember that function names do not have to be symbols ((defun (setf x) (...) ...) is allowed), so we must compare with equal not eql:
(defun/recorded fdescs-equivalent-p (fd1 fd2)
;; do FD1 & FD2 refer to the same function?
(equal (fdesc-name fd1)
(fdesc-name fd2)))
Storing fdescs indexed by lambda list (partial)
To index things efficiently by lambda list we build a tree. The nodes in this tree are called lambda-list-tree-nodes and their definition is not given here.
There are functions which intern a fdesc in a tree, and which return a list of fdescs indexed by a given lambda list. Neither have an implementation here, but this is what they look like:
(defun/recorded intern-lambda-list (lambda-list tree-node fdesc)
;; return the node where it was interned
...)
(defun/recorded lambda-list-fdescs (lambda-list tree-node)
;; Return a list of fdescs for a lambda list & T if there were any
;; or NIL & NIL if there were not (I don't think () & T is possible,
;; but it might be in some future version)
...)
The implementation of these functions will probably need to use use argument-matches-p and fdescs-equivalent-p.
The top-level databases (slightly partial)
Now we can define the top-level database objects: the root of the tree for indexing by lambda list, and a hashtable for indexing by name
(defvar *lambda-list-tree* (make-lambda-list-tree-node))
(defvar *tree-nodes-by-name* (make-hash-table :test #'equal))
Note that *tree-nodes-by-name* maps from names to the node where the information about that function is stored: that's done to make redefinition easier, as seen in the following function:
(defun/recorded record-function-description (name lambda-list)
"Record information about a function called NAME with lambda list LAMBDA-LIST.
Replace any existing information abot NAME. Return NAME."
(let ((fdesc (make-fdesc :name name :lambda-list lambda-list)))
;; First of all remove any existing information
(multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
(when foundp
(setf (lambda-list-tree-node-values node)
(delete fdesc (lambda-list-tree-node-values node)
:test #'fdescs-equivalent-p))))
(setf (gethash name *tree-nodes-by-name*)
(intern-lambda-list lambda-list *lambda-list-tree* fdesc)))
name)
Note that this function first of all looks up any existing information for name, and if it exists it removes it from the node where it was found. This makes sure that function redefinition does not leave obsolete information in the tree.
This function is the actual recorder which defun/recorded wants to know about, so tell it that:
(setf *function-description-recorder*
#'record-function-description)
Now the next time we invoke defun/recorded it will bootstrap the system by inserting all the the pending definitions.
record-function-description is part of the API to the package: it can be used to record information about functions we don't define.
User-interface functions
Apart from defun/recorded & record-function-description we want some functions which let us make enquiries into the database, as well as one which resets things:
(defun/recorded clear-recorded-functions ()
"Clear function description records. Return no values"
(setf *lambda-list-tree* (make-lambda-list-tree-node)
*tree-nodes-by-name* (make-hash-table :test #'equal))
(values))
(defun/recorded name->lambda-list (name)
"Look up a function by name.
Return either its lambda list & T if it is found, or NIL & NIL if not."
(multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
(if foundp
(values
(fdesc-lambda-list
(find-if (lambda (fd)
(equal (fdesc-name fd) name))
(lambda-list-tree-node-values node)))
t)
(values nil nil))))
(defun/recorded lambda-list->names (lambda-list)
"find function names matching a lambda-list.
Return a list of name & T if there are any, or NIL & NIL if none.
Note that lambda lists are matched so that argument names do not match, and arguments with default values or presentp parameters match just on the argument."
(multiple-value-bind (fdescs foundp) (lambda-list-fdescs lambda-list
*lambda-list-tree*)
(if foundp
(values (mapcar #'fdesc-name fdescs) t)
(values nil nil))))
And that's it.
Examples
After compiling, loading & using the package (with the missing bits added) we can first inject some useful extra functions into it (this is just a random scattering)
> (dolist (x '(car cdr null))
(record-function-description x '(thing)))
nil
> (dolist (x '(car cdr))
(record-function-description `(setf ,x) '(new thing)))
nil
> (record-function-description 'cons '(car cdr))
cons
> (record-function-description 'list '(&rest args))
Now we can make some enquiries:
> (lambda-list->names '(x))
(null cdr
car
lambda-list->names
name->lambda-list
com.stackoverflow.lisp.fdesc-search::simplify-lambda-list)
t
> (lambda-list->names '(&rest anything))
(list)
t
> (name->lambda-list 'cons)
(car cdr)
t
An example of storing things in trees
Below is some code which demonstrates one approach to storing information in trees (often known as tries). This is not usable above for a lot of reasons, but reading it might help implement the missing parts.
;;;; Storing things in trees of nodes
;;;
;;; Node protocol
;;;
;;; Nodes have values which may or may not be bound, and which may be
;;; assigned. Things may be interned in (trees of) nodes with a
;;; value, and the value associated with a thing may be retrieved
;;; along with an indicator as to whether it is present in the tree
;;; under the root.
;;;
(defgeneric node-value (node)
;; the immediate value of a node
)
(defgeneric (setf node-value) (new node)
;; Set the immediate value of a node
)
(defgeneric node-value-boundp (node)
;; Is a node's value bound?
)
(defgeneric intern-thing (root thing value)
;; intern a thing in a root, returning the value
(:method :around (root thing value)
;; Lazy: this arround method just makes sure that primary methods
;; don't need to beother returning the value
(call-next-method)
value))
(defgeneric thing-value (root thing)
;; return two values: the value of THING in ROOT and T if is it present, or
;; NIL & NIL if not
)
;;; Implementatation for STRING-TRIE-NODEs, which store strings
;;;
;;; The performance of these will be bad if large numbers of strings
;;; with characters from a large alphabet are stored: how might you
;;; fix this without making the nodes enormous?
;;;
(defclass string-trie-node ()
;; a node in a string trie. This is conceptually some kind of
;; special case of an abstract 'node' class, but that doesn't
;; actually exist.
((children-map :accessor string-trie-node-children-map
:initform '())
(value :accessor node-value)))
(defmethod node-value-boundp ((node string-trie-node))
(slot-boundp node 'value))
(defmethod intern-thing ((root string-trie-node) (thing string) value)
;; intern a string into a STRING-TRIE-NODE, storing VALUE
(let ((pmax (length thing)))
(labels ((intern-loop (node p)
(if (= p pmax)
(setf (node-value node) value)
(let ((next-maybe (assoc (char thing p)
(string-trie-node-children-map node)
:test #'char=)))
(if next-maybe
(intern-loop (cdr next-maybe) (1+ p))
(let ((next (cons (char thing p)
(make-instance (class-of node)))))
(push next (string-trie-node-children-map node))
(intern-loop (cdr next) (1+ p))))))))
(intern-loop root 0))))
(defmethod thing-value ((root string-trie-node) (thing string))
;; Return the value associated with a string in a node & T or NIL &
;; NIL if there is no value for this string
(let ((pmax (length thing)))
(labels ((value-loop (node p)
(if (= p pmax)
(if (node-value-boundp node)
(values (node-value node) t)
(values nil nil))
(let ((next (assoc (char thing p)
(string-trie-node-children-map node)
:test #'char=)))
(if next
(value-loop (cdr next) (1+ p))
(values nil nil))))))
(value-loop root 0))))
;;; Draw node trees in LW
;;;
#+LispWorks
(defgeneric graph-node-tree (node))
(:method ((node string-trie-node))
(capi:contain
(make-instance 'capi:graph-pane
:roots `((nil . ,node))
:children-function (lambda (e)
(string-trie-node-children-map (cdr e)))
:edge-pane-function (lambda (pane parent child)
(declare (ignore pane parent))
(make-instance
'capi:labelled-line-pinboard-object
:text (format nil "~A" (car child))))
:print-function (lambda (n)
(let ((node (cdr n)))
(format nil "~A"
(if (node-value-boundp node)
(node-value node)
""))))))))
In these day i'm working to a json parse in prolog and lisp.
yesterday with your help i finished the prolog project and now i need help again.
the funcion is always json-get but now in lisp.
this is the functin that i wrote:
(defun json-get (json_obj fields &optional n)
(let ((place (assoc fields json_obj :test 'string=)))
(if (null place)
n
(ns (second place) t)))
the behavior of the funtion should be the same of the prolog predicate.
for example if the input is:
CL-prompt> (defparameter x (json-parse "{\"nome\" : \"Arthur\",\"cognome\" : \"Dent\"}"))
X
CL-prompt> x
(json-obj ("nome" "Arthur") ("cognome" "Dent"))
the output should be:
CL-prompt> (json-get x "cognome")
"Dent"
insted, if the input is:
(json-get (json-parse
"{\"name\" : \"Zaphod\",
\"heads\" : [[\"Head1\"], [\"Head2\"]]}")
"heads" 1 0)
the output should be:
"Head2"
the function that i wrote is totally wrong?
P.S. for this project are forbidden functions like SET, SETQ, SETF e MULTIPLE-VALUE-SETQ and DO, DO*, DOTIMES, DOLIST e LOOP and DEFPARAMETER, DEFVAR e DEFCOSTANT inside a function
thanks guys
edit 1:
this is the description of this funcion,
a json-get function that accepts a JSON object
(represented in Common Lisp, as produced by the json_parse function) and a series of
"Fields", retrieve the corresponding object. A field represented by N (with N a number
greater than or equal to 0) represents an index of a JSON array.
edit 2 :
if i try to run json-get lisp answer me with:
Error: The variable PLACE is unbound.
You need to implement this recursively. You also need to distinguish JSON arrays (which are implemented as a list of elements prefixed with json-array) and JSON objects (which are implemented as an association list.
(defun json-get (json_obj fields)
(if (null fields) ; base case of recursion
json_obj
(let* ((cur-key (car fields))
(current (cond ((and (integerp cur-key)
(eq (car json_obj) 'json-array))
(nth (1+ cur-key) json_obj)) ; add 1 to skip over JSON-ARRAY
((and (stringp cur-key)
(eq (car json_obj) 'json-obj))
(second (assoc cur-key (cdr json_obj) :test #'string=))) ; Use CDR to skip over JSON-OBJ
(t (error "~S is not a JSON object or array or ~s is not appropriate key" json_obj cur-key)))))
(json-get current (cdr fields)))))
fields has to be a list of fields, so your second example would be:
(json-get (json-parse
"{\"name\" : \"Zaphod\",
\"heads\" : [[\"Head1\"], [\"Head2\"]]}")
'("heads" 1 0))
and the first example should be:
(json-get x '("cognome"))
Good morning i need help to write this function in lisp.
this is the description.
The json-write function writes the JSON object to the filename file in JSON syntax. If
filename does not exist, it is created and if it exists it is overwritten. Of course it is expected that
CL-PROMPT> (json-load (json-write '(json-obj # | stuff | #) "foo.json"))
(json-obj # | stuff | #)
and this is my function but it isn't correct
(defun json-write (json filename)
(with-open-file (out filename
:direction :output
:if-exists :overwrite
:if-does-not-exist :create)
(pprint (json out))))
thanks
Edit 1:
i try to write var json (that is a json object) into filename.
but pprint doesn't write anything to filename
Edit 2:
(defun json-write (json filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(cond
((equal (first json) ‘json-array) (write-arr json))
((equal (first json) ‘json-obj) (write-obj json)))))
so i try this now
if json is json-array lisp call write-arr json
if json is json-obj call write-obj
so my idea is that write-arr trasform
(json-array 1 2 3) in `"[1, 2, 3]"` to make it parsable
and write-obj trasform
(json-obj ("nome" "Arthur") ("cognome" "Dent"))
in
"{\"nome\" : \"Arthur\",
\"cognome\" : \"Dent\"}"
and then write everythings into filename with format stream.
how can i format (json-array 1 2 3) in "[1, 2, 3]".
with format function? and then calling recursively even this function?
thank you
When you write (pprint (json out)) you are trying to call a global function called json. I think you mean (pprint json out).
Now here is roughly how to write a simple json printer:
(defun write-json (object stream)
(etypecase object
(number (format stream “~a” object))
(string (print object stream))
(null (format stream “null”))
(cons
(ecase (car object)
(json-array
(write-char #\[ stream)
(loop for (x . r) on (cdr object)
do (write-json x stream)
(when r (write-char #\, stream)))
(write-char #\] stream))))))
There are plenty of gaps to fill in. And note that this will print strings wrong if they contain new lines. And you probably want to do something less stupid for printing numbers.
Here is how I would implement a json pretty printer with CLOS:
(defvar *json-pretty* nil)
(defvar *json-indent-level* 0)
(defvar *json-indent-spaces* 2)
(defun json-fresh-line (stream)
(if *json-pretty*
(progn
(fresh-line stream)
(loop repeat (* *json-indent-level* *json-indent-spaces*)
do (write-char #\Space stream)))
(write-char #\Space stream))
(defgeneric write-json (object stream))
(defgeneric write-json-collection (type data stream))
(defmethod write-json ((object cons) stream)
(write-json-collection (car object) (cdr object) stream))
(defmethod write-json-collection ((tag (eql json-array)) data stream)
...)
There are plenty of methods left to write.
I'm beginner to this so sorry if I overlook something simple...
I'd like to use emacs org-mode for my HTML pages. The 'default' setup is nice and working, however I'd like to use one of the free web templates, e.g. http://www.freecsstemplates.org/preview/goodlife/
These templates provide CSS files, however just usage of CSS in org-mode's HTML export seem not to be enough. It seems that to use these templates correctly I need as well to maintain HTML structure as shown in such template.
How can I force org-mode to generate HTML structure I like (i.e. frame division)?
It seems, that some options are offered by 'org-export-generic.el'. Even if I would persuade generic export to provide me with a single HTML page, it still does not resolve completely the HTML export....
This section of the org-mode manual provides some guidance on exporting to html and using css http://orgmode.org/manual/CSS-support.html#CSS-support This includes a description of the default classes org-mode uses so you could modify your CSS.
If you want to modify org mode exports to match your CSS classes and ids use the :HTML_CONTAINER_CLASS: property in an org headline and the :CUSTOM_ID: property for creating ids.
Instead of setting things up per file I use org mode's publishing ability to output many org files into a single website. You can find a tutorial on that here http://orgmode.org/worg/org-tutorials/org-publish-html-tutorial.html
My org-publish-project-alist looks like:
'(org-publish-project-alist (quote (("requirements" :components ("req-static" "req-org"))
("req-static" :base-directory "~/org/requirements" :publishing-directory "~/public_html/requirements/" :base-extension "gif\\|css" :publishing-function org-publish-attachment)
("req-org" :base-directory "~/org/requirements/" :publishing-directory "~/public_html/requirements/" :style "<link rel=\"stylesheet\" type=\"text/css\" href=\"./style.css\" />" :section-numbers nil :headline-levels 3 :table-of-contents 2 :auto-sitemap t :sitemap-filename "index.org" :sitemap-title "Requirements for My Software" :link-home "./index.html"))
I agree. The HTML generated by org's built-in export is good but not quite what I'd want. It appears that the generic export are based on elisp, whereas I prefer XSLT.
I wrote the following code for turning an org file into XML, but I haven't written the publishing transforms yet. Anyway, this may be helpful for your reference, especially as it shows the structure of an org document's internal representation.
(require 'org-element)
(defvar xml-content-encode-map
'((?& . "&")
(?< . "<")
(?> . ">")))
(defvar xml-attribute-encode-map
(cons '(?\" . """) xml-content-encode-map))
(defun write-xml (o out parents depth)
"Writes O as XML to OUT, assuming that lists have a plist as
their second element (for representing attributes). Skips basic
cycles (elements pointing to ancestor), and compound values for
attributes."
(if (not (listp o))
;; TODO: this expression is repeated below
(princ o (lambda (charcode)
(princ
(or (aget xml-content-encode-map charcode)
(char-to-string charcode))
out)))
(unless (member o parents)
(let ((parents-and-self (cons o parents))
(attributes (second o)))
(dotimes (x depth) (princ "\t" out))
(princ "<" out)
(princ (car o) out)
(loop for x on attributes by 'cddr do
(let ((key (first x))
(value (second x)))
(when (and value (not (listp value)))
(princ " " out)
(princ (substring (symbol-name key) 1) out)
(princ "=\"" out)
(princ value (lambda (charcode)
(princ
(or (aget xml-attribute-encode-map charcode)
(char-to-string charcode))
out)))
(princ "\"" out))))
(princ ">\n" out)
(loop for e in (cddr o) do
(write-xml e out parents-and-self (+ 1 depth)))
(dotimes (x depth) (princ "\t" out))
(princ "</" out)
(princ (car o) out)
(princ ">\n" out)))))
(defun org-file-to-xml (orgfile xmlfile)
"Serialize ORGFILE file as XML to XMLFILE."
(save-excursion
(find-file orgfile)
(let ((org-doc (org-element-parse-buffer)))
(with-temp-file xmlfile
(let ((buffer (current-buffer)))
(princ "<?xml version='1.0'?>\n" buffer)
(write-xml org-doc buffer () 0)
(nxml-mode)))))
(find-file xmlfile)
(nxml-mode))
(defun org-to-xml ()
"Export the current org file to XML and open in new buffer.
Does nothing if the current buffer is not in org-mode."
(interactive)
(when (eq major-mode 'org-mode)
(org-file-to-xml
(buffer-file-name)
(concat (buffer-file-name) ".xml"))))
I'm looking for a solution that allows me to write native Emacs Lisp code and at compile time turns it into HTML, like Franz's htmlgen:
(html
((:div class "post")
(:h1 "Title")
(:p "Hello, World!")))
Of course I can write my own macros, but I'm interested if there are any projects around this problem.
As you found out, xmlgen generates XML from a list structure. What I did find disappointing with the ``xmlgen` package that the format it supports is not quite the inverse of Emacs' xml parser.
I did add this to my copy of xmlgen:
;; this creates a routine to be the inverse of what xml-parse does
;;;###autoload
(defun xml-gen (form &optional in-elm level)
"Convert a sexp to xml:
'(p :class \"big\")) => \"<p class=\\\"big\\\" />\""
(let ((level (or level 0)))
(cond
((numberp form) (number-to-string form))
((stringp form) form)
((listp form)
(destructuring-bind (xml attrs) (xml-gen-extract-plist form)
(let ((el (car xml)))
(unless (symbolp el)
(error "Element must be a symbol (got '%S')." el))
(setq el (symbol-name el))
(concat "<" el (xml-gen-attr-to-string attrs)
(if (> (length xml) 1)
(concat ">" (mapconcat
(lambda (s) (xml-gen s el (1+ level)))
(cdr xml)
"")
"</" el ">")
"/>"))))))))
(defun xml-gen-attr-to-string (plist)
(reduce 'concat (mapcar (lambda (p) (concat " " (symbol-name (car p)) "=\"" (cdr p) "\"")) plist)))
(defun xml-gen-extract-plist (list)
(list (cons (car list) (let ((kids (xml-node-children list)))
(if (= 1 (length kids))
kids
(remove-if-not 'listp kids))))
(xml-node-attributes list)))
Note: the interface for this is xml-gen (not xmlgen which is the original parsing).
With this interface, the following holds:
(string-equal (xml-gen (car (xml-parse-region <some-region-of-xml>)))
<some-region-of-xml>)
and
(equal (car (xml-parse-region (insert (xml-gen <some-xml-form>))))
<some-xml-form>)
The new xml-gen does not strive to preserve the whitespace around that the xml-parse-region routine generates.
This could be a starting point: http://www.emacswiki.org/emacs/HtmlLite
This is not quite what you're looking for, but there's a 20 minute video where a guy creates a simple website using UCW, the UnCommon Web application framework. It's all done in Emacs using lisp...
Here is a link to the transcript (all the code (~25 lines) is available at the end of the transcript).
Meanwhile, I found some code that contains something similar I want. Now I can write:
(views-with-html
((body)
(h1 "Title")
((p (class . "entry")) "Hello, World!")))
The implementation has a few limitations (e.g. hard-coded element list), but it seems to be a good starting point.
I had a similar requirement to be able to parse xml using xml-parse functions, transform it, and then output it back as a xml string.
Trey's solution almost worked except I needed to retain the whitespace xml elements. So I wrote my own implementation here:
https://github.com/upgradingdave/xml-to-string
Have you considered yaclml?
yaclml (Yet Another Common Lisp Markup Language) is an HTML generator and HTML template library. yaclml is used as the html templating backend for the ucw web framework.
https://www.cliki.net/yaclml
It is in common lisp. Not elisp. But, ...