Let's say I have a struct (which has more parameters than shown here):
(defstruct location
name)
And an association list defining a series of locations using the backquote:
(defparameter *locations* `(
(ASIA ,(make-location :name "Asia"))
(AFRICA ,(make-location :name "Africa"))
)
This works fine and correctly creates the location structs. The problem is, I'm planning on having a lot of locations, more than would be nice to type out all by hand:
(defparameter *locations* `(
(ASIA ,(make-location :name "Asia"))
(AFRICA ,(make-location :name "Africa"))
(LOC1 ,(make-location :name "Location 1"))
; Lots more...
(LOC1024 ,(make-location :name "Location 1027"))
)
A lot of these extra locations have similar parameters, such that I can define a "generator function" to create a list of them:
(defun generate-locations (symbol name count)
(loop for i from 1 to count collect (list
(read-from-string (format nil "~A~D" symbol i))
(make-location :name name))))
;;; Creates list ((LOC1 #S(LOCATION :NAME "Location 1")) (LOC2 ...
(generate-locations "LOC" "Location " 1024)
So then I tried to do something like:
(defparameter *locations* `(
(ASIA ,(make-location :name "Asia"))
(AFRICA ,(make-location :name "Africa"))
,(generate-locations "LOC" "Location " 1024)
)
Doesn't work, because GENERATE-LOCATIONS returns a list, not a series of elements which can then be added to a list. So I tried to VALUES-LIST it:
(defparameter *locations* `(
(ASIA ,(make-location :name "Asia"))
(AFRICA ,(make-location :name "Africa"))
,(values-list (generate-locations "LOC" "Location " 1024))
)
This only adds the first generated location to *LOCATIONS*. I'm assuming this is because all return values except the first of VALUES-LIST are ignored.
So how do I correctly add a series of elements to *LOCATIONS*? Should GENERATE-LOCATIONS be a macro? And if so, how would it be structured?
You need to use the splicing unquote operator, ,#. In your example:
(defparameter *locations* `(
(ASIA ,(make-location :name "Asia"))
(AFRICA ,(make-location :name "Africa"))
,#(generate-locations "LOC" "Location " 1024)
)
For this to work, generate-locations should return a list. ,# will splice each item into the surrounding list, rather than inserting it as a single item.
Related
Alright first of all this is my first question so I apologize for any bad practice and appreciate if you tell me I'm doing something wrong.
I am trying to write a macro to reduce repetitive code, which is create a package, system or code file in Common Lisp with a chapter number in its name. The following code is what I have and it works perfectly when :chapter-number is passed as a string, but goes wrong when it is passed as number:
(defmacro with-open-chapter-file
((streamvar (component &key
(type "lisp")
(directory (sb-posix:getcwd))
chapter-number))
(&body body))
`(let ((chapter-number ,(if (numberp chapter-number) ; the problem is at this if clause.
(write-to-string chapter-number) ; My intention was to convert it to a string if it was a number or leave it as is otherwise.
chapter-number)))
(with-open-file (,streamvar (make-pathname
:name ,(if chapter-number ; the variable manipulated in the if clause is used in this expression
(concatenate 'string "chapter-" chapter-number "-" (string component))
component)
:type ,type
:defaults ,directory)
:direction :output)
,body)))
When I run the following test:
(macroexpand-1 '(with-open-chapter-file (out ("pack" :chapter-number 10))
(format t "Hey!")))
I get the error:
The value
10
is not of type
SEQUENCE
[Condition of type TYPE-ERROR]
And the backtrace:
0: (LENGTH 10)
1: (SB-KERNEL:%CONCATENATE-TO-STRING "chapter-" 10 "-" "pack")
2: ((MACRO-FUNCTION WITH-OPEN-CHAPTER-FILE) (WITH-OPEN-CHAPTER-FILE (OUT ("pack" :CHAPTER-NUMBER 10)) (FORMAT T "Hey!")) #<unused argument>)
3: ((FLET SB-IMPL::PERFORM-EXPANSION :IN MACROEXPAND-1) #<FUNCTION (MACRO-FUNCTION WITH-OPEN-CHAPTER-FILE) {2278173B}> NIL)
4: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MACROEXPAND-1 (QUOTE (WITH-OPEN-CHAPTER-FILE # #))) #<NULL-LEXENV>)
5: (EVAL (MACROEXPAND-1 (QUOTE (WITH-OPEN-CHAPTER-FILE # #))))
I would be extremely grateful if you guys could help me.
In the code:
:name ,(if chapter-number ; the variable manipulated in the if clause is used in this expression
(concatenate 'string "chapter-" chapter-number "-" (string component))
component)
you're using the chapter-number parameter to the macro, not the variable that you bound with let in the expansion, because this code is after a comma.
You shouldn't be binding that variable in the expansion, you should just update the variable in the macro itself.
(defmacro with-open-chapter-file
((streamvar (component &key
(type "lisp") (directory (sb-posix:getcwd)) chapter-number))
(&body body))
(when (numberp chapter-number)
(setq chapter-number (write-to-string chapter-number)))
`(with-open-file (,streamvar (make-pathname
:name ,(if chapter-number
(concatenate 'string "chapter-" chapter-number "-" (string component))
component)
:type ,type
:defaults ,directory)
:direction :output)
,#body))
Another solution that doesn't require testing the type of chapter-number is to change the code that uses concatenate to use format:
(if chapter-number
(format nil "chapter-%A-%A" chapter-number component)
component)
An unrelated mistake is that you should use ,#body to substitute the body, since it's a list that must be spliced into the expression.
A typical problem with macros is to understand that in general they deal with code: they receive code and produce code. Generally they don't know the value of variables, because the code has not been run yet.
For example imagine:
(let ((n 10))
(with-open-chapter-file (out ("pack" :chapter-number n))
(format t "Hey!")))
Now there is no general way in the macro to know what the value of n is. When the macro form gets expanded during compilation, it sees a n and nothing more.
Now when you have an actual number in the code, the macro sees that number as part of the source:
(with-open-chapter-file (out ("pack" :chapter-number 10)
(format t "Hey!")))
Now we can ask us, if it would make sense for the macro to recognize the number during macro expansion and to compute something at macro expansion time? It's kind of an optimization and it might not be worth it. Now, the compiler might detect that it is a constant and could be converted at compile time...
Thus in your example it might be okay to at runtime convert the argument to a string, instead of doing it at macroexpansion time.
Now lets assume the code looks like this:
(defmacro with-open-chapter-file
((streamvar (component
&key
(type "lisp")
(directory "/foo/")
chapter-number))
(&body body))
(when (numberp chapter-number)
(setf chapter-number (write-to-string chapter-number)))
`(let ((component ,component)
(type ,type)
(directory ,directory)
(chapter-number ,chapter-number))
(when (numberp chapter-number)
(setf chapter-number (write-to-string chapter-number)))
(with-open-file
(,streamvar (make-pathname
:name (if chapter-number
(format nil
"chapter-~a-~a"
chapter-number
component)
component)
:type type
:defaults directory)
:direction :output)
,#body)))
Now we can do this:
a) with n
CL-USER 6 > (pprint (macroexpand-1 '(with-open-chapter-file (out ("pack" :chapter-number n))
(format t "Hey!"))))
(LET ((COMPONENT "pack") (TYPE "lisp") (DIRECTORY "/foo/") (CHAPTER-NUMBER N))
(WHEN (NUMBERP CHAPTER-NUMBER) (SETF CHAPTER-NUMBER (WRITE-TO-STRING CHAPTER-NUMBER)))
(WITH-OPEN-FILE (OUT
(MAKE-PATHNAME :NAME
(IF CHAPTER-NUMBER
(FORMAT NIL "chapter-~a-~a" CHAPTER-NUMBER COMPONENT)
COMPONENT)
:TYPE
TYPE
:DEFAULTS
DIRECTORY)
:DIRECTION
:OUTPUT)
FORMAT
T
"Hey!"))
and b) with 10
CL-USER 7 > (pprint (macroexpand-1 '(with-open-chapter-file (out ("pack" :chapter-number 10))
(format t "Hey!"))))
(LET ((COMPONENT "pack") (TYPE "lisp") (DIRECTORY "/foo/") (CHAPTER-NUMBER "10"))
(WHEN (NUMBERP CHAPTER-NUMBER) (SETF CHAPTER-NUMBER (WRITE-TO-STRING CHAPTER-NUMBER)))
(WITH-OPEN-FILE (OUT
(MAKE-PATHNAME :NAME
(IF CHAPTER-NUMBER
(FORMAT NIL "chapter-~a-~a" CHAPTER-NUMBER COMPONENT)
COMPONENT)
:TYPE
TYPE
:DEFAULTS
DIRECTORY)
:DIRECTION
:OUTPUT)
FORMAT
T
"Hey!"))
But since format does a conversion anyway during printing, we can remove all that conversion logic...
(defmacro with-open-chapter-file
((streamvar (component
&key
(type "lisp")
(directory "/foo/")
chapter-number))
(&body body))
`(let ((component ,component)
(type ,type)
(directory ,directory)
(chapter-number ,chapter-number))
(let ((name (if chapter-number
(format nil
"chapter-~a-~a"
chapter-number
component)
component)))
(with-open-file (,streamvar (make-pathname
:name name
:type type
:defaults directory)
:direction :output)
,#body))))
Now you need to make sure that component, type ... are not unwanted runtime variables which then were visible from the body code...
I am trying to get the first row under the column with the title "Name" so for example for https://en.wikipedia.org/wiki/List_of_the_heaviest_people I want to return the name "Jon Brower Minnoch". My code so far is as follows, but I think there must be a more general way of getting the name:
(defun find-tag (tag doc)
(when (listp doc)
(when (string= (xmls:node-name doc) tag)
(return-from find-tag doc))
(loop for child in (xmls:node-children doc)
for find = (find-tag tag child)
when find do (return-from find-tag find)))
nil)
(defun parse-list-website (url)
(second (second (second (third (find-tag "td" (html5-parser:parse-html5 (drakma:http-request url) :dom :xmls)))))))
and then to call the function:
(parse-list-website "https://en.wikipedia.org/wiki/List_of_the_heaviest_people")
I am not very good with xmls and don't know how to get an get a td under a certain column header.
The elements in the document returned by html5-parser:parse-html5 are in the form:
("name" (attribute-alist) &rest children)
You could access the parts with the standard list manipulation functions, but xmls also provides functions node-name, node-attrs and node-children to access the three parts. It's a little bit clearer to use those. Edit: there are also functions xmlrep-attrib-value, to get the value of an attribute and xmlrep-tagmatch to match the tag name. The children are either plain strings, or elements in the same format.
So for example, a html document with a 2x2 table would look like this:
(defparameter *doc*
'("html" ()
("head" ()
("title" ()
"Some title"))
("body" ()
("table" (("class" "some-class"))
("tr" (("class" "odd"))
("td" () "Some string")
("td" () "Another string"))
("tr" (("class" "even"))
("td" () "Third string")
("td" () "Fourth string"))))))
In order to traverse the dom-tree, lets define a recursive depth-first search like this (note that the if-let depends on the alexandria library (either import it, or change it to alexandria:if-let)):
(defun find-tag (predicate doc &optional path)
(when (funcall predicate doc path)
(return-from find-tag doc))
(when (listp doc)
(let ((path (cons doc path)))
(dolist (child (xmls:node-children doc))
(if-let ((find (find-tag predicate child path)))
(return-from find-tag find))))))
It's called with a predicate function and a document. The predicate function gets called with two arguments; the element being matched and a list of its ancestors. In order to find the first <td>, you could do this:
(find-tag (lambda (el path)
(declare (ignore path))
(and (listp el)
(xmls:xmlrep-tagmatch "td" el)))
*doc*)
; => ("td" NIL "Some string")
Or to find the first <td> in the even row:
(find-tag (lambda (el path)
(and (listp el)
(xmls:xmlrep-tagmatch "td" el)
(string= (xmls:xmlrep-attrib-value "class" (first path))
"even")))
*doc*)
; => ("td" NIL "Third string")
Getting the second <td> on the even row would require something like this:
(let ((matches 0))
(find-tag (lambda (el path)
(when (and (listp el)
(xmls:xmlrep-tagmatch "td" el)
(string= (xmls:xmlrep-attrib-value "class" (first path))
"even"))
(incf matches))
(= matches 2))
*doc*))
You could define a helper function to find the nth tag:
(defun find-nth-tag (n tag doc)
(let ((matches 0))
(find-tag (lambda (el path)
(declare (ignore path))
(when (and (listp el)
(xmls:xmlrep-tagmatch tag el))
(incf matches))
(= matches n))
doc)))
(find-nth-tag 2 "td" *doc*) ; => ("td" NIL "Another string")
(find-nth-tag 4 "td" *doc*) ; => ("td" NIL "Fourth string")
You might want to have a simple helper to get the text of a node:
(defun node-text (el)
(if (listp el)
(first (xmls:node-children el))
el))
You could define similiar helpers to do whatever you need to do in your application. Using these, the example you gave would look like this:
(defparameter *doc*
(html5-parser:parse-html5
(drakma:http-request "https://en.wikipedia.org/wiki/List_of_the_heaviest_people")
:dom :xmls))
(node-text (find-nth-tag 1 "a" (find-nth-tag 1 "td" *doc*)))
; => "Jon Brower Minnoch"
I'm trying to build a function to access records in a database as such:
(select :title "milk" :rating 7)
However, it's just returning all of the records in the database. I believe this is because I'm passing &rest arguments to a macro and it's interpreting the parameter name "fields" literally. I've tried removing &rest from my macro, but then I get an error about not passing a list. I've tried calling (list fields) in various places to no avail (in the macro, in the function that calls the macro, in the function that the macro calls).
The following code works as expected:
(select-custom (where :title "milk" :rating 7))
And returns only the records which match the arguments.
source code:
(defun select (&rest fields)
(select-custom (where fields)))
(defun select-custom (selector-function)
(remove-if-not selector-function *db*))
(defmacro where (&rest fields)
`#'(lambda (cd) (and ,#(make-comparison-list fields))))
(defun make-comparison-list (fields)
(loop while fields
collecting (make-comparison-exp (pop fields) (pop fields))))
(defun make-comparison-exp (field value)
`(equal (getf cd ,field) ,value))
You could just make select a macro instead
(defmacro select (&rest fields)
`(select-custom (where ,#fields)))
You can check that
(macroexpand-1 '(select :title "milk" :rating 7))
returns
(SELECT-CUSTOM (WHERE :TITLE "milk" :RATING 7))
The best solution would be to create a function version of where. But as a simple kludge, you can use eval
(defun select (&rest fields)
(select-custom (eval `(where ,#fields))))
I have a hash-table and would like to export the hash-tables into an org-buffer.
What the hash-table should print out to an org-buffer:
take the keys, if the key's value is not a hash then it's ":: " otherwise if the key's value is a hash-table then the key is a heading and so on.
Q.
1. I couldn't find if there is an 'import' into the org-buffer implemented already. If there is, can someone point me to it?
2. Has someone written anything similar to this? I can do it (it seems simple enough) but would hate to reinvent the wheel. If there is a library already out there that can take a structure (hash-table) and import it into an org-buffer, that would be awesome.
Thanks.
I have provided an example of the output of what that hash-table should be represented into the org-buffer and the raw hash-table.
* key "project-example"
:id: "12345"
** affected-versions
:id: "12332"
:name: "SlimShady"
:archived: nil
:release-date: "2014-10-01T04:00:00.000Z"
:released: nil
:sequence: 81
:assigned-to: "m&m"
:attach-name: nil
** components
:id: "3214"
:name: "Dr.Dre"
:created: "2014-11-13T15:49:15.000Z"
** customer-fld-vals:
:custom-fld-id: "cust-id-112233"
:key: nil
:values: "Fill me"
:description: nil
:duedate: nil
:environment: nil
:fixVersions: nil
:key: "project-example"
:priority: "high"
:project: "EX"
:reporter: "YourName"
:resolution: "xx"
:status: "xx"
:summary: "Write something here"
:type: "xx"
:updated: "2014-11-15T22:52:13.000Z"
:votes: 0
Raw-hash (i have a list which has only one hash in it):
((hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data
(id "12345" affected-versions #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data
(id "12332" name "SlimShady" archived nil release-date "2014-10-01T04:00:00.000Z" released nil sequence 81))
assigned-to "m&m" attach-name nil components #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data
(id "3214" name "Dr.Dre"))
created "2014-11-13T15:49:15.000Z" customer-fld-vals #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data
(customfieldId "cust-id-112233" key nil values
("Fill me")))
description nil duedate nil environment nil fixVersions nil key "project-example" priority "high" project "EX" reporter "YourName" resolution "xx" status "xx" summary "Write something here" type "xx" updated "2014-11-15T22:52:13.000Z" votes 0)))
I have stolen you all the fun;-). The output is a bit different to what you suggested. I do not indent the headers of the leaves so that org recognizes the structure.
(defun org-import-hash (title hash &optional level noindent)
"Import HASH table into an org buffer.
Put TITLE into the first heading.
The hash table starts with LEVEL where LEVEL defaults to 1.
Indent inserted region by org-mode unless NOINDENT is non-nil."
(interactive "sTitle:\nXHash-table:")
(unless level (setq level 1))
(let ((b (point)))
(insert (if (or (looking-back "\n") (= (point) 1)) "" "\n") (make-string level ?*) (format " %s\n" title))
(maphash (lambda (key val)
(cond
((hash-table-p val)
(org-import-hash key val (1+ level) t))
;; other special cases here
(t
(insert (format " :%s: %s\n" key val)))
))
hash)
(unless noindent
(indent-region b (point)))
))
The comment section would not allow me extra characters so I couldn't post this code there.
Thank you for your solution, it's neat!!
I am new to elisp and do not know all the functions properly. Really like the 'make-string', my alternative is that I keep a list of stars per heeding and then concat them wherever necessary.
I came up with solution shortly after i asked the question. I like your approach.
A few notes about my hash is that all the keys are symbols hence this: '(symbol-name k)'
(defun ->string (whatever)
(cond
((equal 'integer (type-of whatever)) (number-to-string whatever))
((equal 'cons (type-of whatever)) (mapconcat 'identity (mapcar '->string whatever) " " ))
((equal 'string (type-of whatever)) whatever)))
(defun out->print (dstring)
(print dstring))
(defun out->buffer (dstring)
(insert dstring))
(defun print-issues (dhash stars)
(maphash (lambda (k v)
(progn (if (equal 'hash-table (type-of v))
(progn
(let ((nstars (cons "*" stars)))
(out->buffer (concat (apply 'concat nstars) " " (symbol-name k) "\n"))
(print-issues v nstars)))
(out->buffer (concat (replace-regexp-in-string "\*" "\s"
(apply 'concat stars))
":"
(symbol-name k)
":"
" -- "
(->string v) "\n")))))
dhash))
Not clear on some fundamental syntax here. define-key accepts a set of inputs, one of which is inside square braces. What is that construct? How can I dynamically generate what goes inside the square braces?
In the simple case, I can display a one-item menu like this:
(flet ((ok (&optional p1 &rest args) t))
(setq menu-1 (make-sparse-keymap "Title"))
(define-key menu-1 [menu-1-ok-event]
`(menu-item "OK"
ok
:keys ""
:visible t
:enable t))
(x-popup-menu t menu-1))
I can insert additional menu items like this:
(flet ((ok (&optional p1 &rest args) t))
(setq menu-1 (make-sparse-keymap "Title"))
(define-key menu-1 [menu-1-event-ok]
`(menu-item "OK"
ok
:keys ""
:visible t
:enable t))
(define-key menu-1 [menu-1-event-1]
`(menu-item "This is line 1"
nil
:keys ""
:visible t
:enable t))
(x-popup-menu t menu-1))
But what if I want to dynamically generate the thing inside square braces? What if I want something like this:
(while (< n 5)
(define-key menu-1 [(dynamic-thing n)]
`(menu-item (format "This is line %d" n)
nil
:keys ""
:visible t
:enable t)))
I tried
(define-key menu-1 [(intern (format "menu-1-event-%d" n))]
...
..but that did not work. The result is always "intern". ???
What are the square braces? The syntax is unfamiliar to me.
These are vectors. [foo bar] is syntactic sugar for (quote (vector foo bar)); it's a literal. To construct a vector where the elements need to be evaluated, use the vector built-in function explicitly; it works like list.
(define-key menu-1 (vector (format "menu-1-event-%d" n)) …
The chapter on menu keymaps may help as well.