How to produce double quotes instead of single quotes for XML attributes in CL-WHO - common-lisp

By default, CL-WHO uses single quotes for quoting XML attributes values (e.g. <h1 id='title'>Hello!</h1>). I am trying to set cl-who:*attribute-quote-char* to #\" so that attribute values use double quotes instead (e.g. <h1 id="title">Hello!</h1>). However, (setq cl-who:*attribute-quote-char #\") does not seem to have any effect when I use it in ASDF like this:
myprog.asd:
(defpackage myprog-asd
(:use :cl :asdf))
(in-package :myprog-asd)
(defsystem "myprog"
:depends-on (:cl-who)
:components ((:file "mypackage")))
mypackage.lisp:
(defpackage :mypackage
(:use :cl)
(:export :f))
(in-package :mypackage)
(setq cl-who:*attribute-quote-char* #\") ;; <- HERE.
(defun f ()
(cl-who:with-html-output (*standard-output*)
(:h1 :id "title" "Hello!")))
I am getting single quotes instead of double quotes:
$ sbcl
* (require "asdf")
* (asdf:load-asd (merge-pathnames "myprog.asd" (uiop:getcwd)))
* (asdf:load-system :myprog)
* (mypackage:f)
<h1 id='title'>Hello!</h1>
Why is (setq cl-who:*attribute-quote-char #\") not having any effect? How do I make CL-WHO print double quotes instead of single quotes?
(SBCL version: 2.2.2, CL-WHO version: 1.1.4 [commit: 0d382647])
By the way, I found that I could get double quotes by wrapping the setq in an eval-when:
(eval-when (:compile-toplevel :execute)
(setq cl-who:*attribute-quote-char* #\"))
However, I have no idea how or why this works.

This is happening because with-html-output is smart enough to spot (some, it necessarily can not spot all) cases where the generated HTML is a constant string. In those cases it just turns the whole thing into a macroexpansion-time constant. and that happens before you have assigned to the variable, which happens at load time. That's why wrapping it with (eval-when (... :compile-toplevel) ...) works.

Related

Why getf does not work for these keywords in Common Lisp?

I can use getf to extract values inside a list:
CL-USER>(defvar regular-list-keys '(:name "pedro" :value "2985"))
REGULAR-LIST-KEYS
CL-USER> (getf regular-list-keys :name)
"Pedro"
CL-USER> (getf regular-list-keys :value)
"2985"
Ok. I was expecting the same to happen when dealing with |:keywords|:
CL-USER> (defvar odd-list-keys '(|:name| "jazoest" |:value| "2985" |:type| "hidden"))
ODD-LIST-KEYS
CL-USER> (getf odd-list-keys :name)
NIL
CL-USER> (getf odd-list-keys |:name|)
error
Why does this happen? And how can I solve this?
Obs.: I can change previous work which is returning data with |:foo| format if it is necessary.
There's two problems.
First, escaping a symbol prevents case folding. So with the pipes, you get lowercase symbols, rather than the default uppercase symbols (unless you've modified (readtable-case *readtable)).
Second, putting : inside the pipes makes it a literal character in the symbol name, not the keyword package prefix. So you're creating an ordinary symbol in the current package, not a keyword.
:name is a symbol named "NAME" in the KEYWORD package. |:name| is a symbol named ":name" in the CL-USER package.
Symbols that aren't in the KEYWORD package don't automatically evaluate to themselves. So you need to quote |:name|. This will work:
(getf odd-list-keys '|:name|)

Expand a file name with a tilde to its fullpath (Common Lisp)

I have a directory name (as string) with a tilde: ~/projects.
I want to get its fullpath: /home/user/projects. How do I do that ?
The goal is to pass it to uiop:run-program, that doesn't seem to do the right thing©.
With this answer: How to translate (make-pathname :directory '(:absolute :home "directoryiwant") into absolute path
(merge-pathnames
(make-pathname
:directory '(:relative "~/projects"))
(user-homedir-pathname))
#P"/home/me/~/projects/"
=> WRONG
Thank you.
edit I'll share more context.
I wanted to run a program through uiop:launch-program. I had a user-defined list of directories such as ~/projects. Using it as is created the ./~/projects directory instead of /home/user/projects.
truename doesn't work if the directory doesn't exist.
On SBCL, (namestring "~/doesntexist") returns also its tilde.
merge-pathnames didn't work, still the tilde problem.
Feeding ensure-directories-exist with this result created a directory named ~.
Given the answers, I had no choice but to adapt the logic to expand the directory name of a directory we actually want to exist.
;; Create a directory
;; Ensure its name (string) ends with a slash.
(setf mydir
(str:concat (string-right-trim (list #\/) mydir)
"/"))
(ensure-directories-exist base)
Then I could use its truename.
General remarks about ~
Your Lisp implementation may or may not support tilde syntax.
If it does (e.g. CCL, ABCL, CLISP, ECL, LispWorks), then truename would consistently expand to a filename:
(truename "~/projects")
=> /home/user/projects
If your implementation doesn't, or if you want to code portably, you have to merge relatively to (user-homedir-pathname):
(truename (merge-pathnames #p"projects" (user-homedir-pathname)))
=> /home/user/projects
Note that the tilde, if it is supported, seems to only be supported for strings used as pathnames, and not in directory components; (:relative "~") does not work as you would expect, and refers to a directory literaly named "~".
Instead, at least for SBCL, the appropriate directory is (:absolute :home), or, if you want to refer to another user, you can wrap the component in a list:
(make-pathname :directory '(:absolute (:home "root")))
=> #P"~root/"
Notice how it only works if the :home form is just after :absolute, it doesn't work otherwise (see Home Directory Specifiers).
Expanding to non-existent pathnames
truename would require that the thing exists?
Yes, if you want to build the absolute path to a file that does not exist (yet), then you need to call truename on the part that exists, and merge with that.
In your case, that would be (truename "~/"), which is the same as (user-homedir-pathname).
As pointed out by Rainer Joswig, calling namestring on implementations other than SBCL returns an expanded pathname, translating ~ as /home/user. In SBCL you have to call sb-ext:native-namestring to obtain the same effect.
In other words, in order to expand to a filename that does not necessarily exist, you could write the following portability layer:
(defun expand-file-name (pathname)
(check-type pathname pathname)
(block nil
#+(or lispworks clozure cmu clisp ccl armedbear ecl)
(return (namestring pathname))
#+sbcl
(return (native-namestring pathname))
#+(not (or sbcl lispworks clozure cmu clisp ccl armedbear ecl))
(let ((expanded (namestring pathname)))
(prog1 expanded
(assert (not find #\~ expanded) ()
"Tilde not supported")))))
See also https://github.com/xach/tilde/blob/master/tilde.lisp for inspiration if your Lisp doesn't support the syntax.
There is a native-namestring function in uiop, which should be available in all implementations:
(uiop:native-namestring "~/projects")
=> /home/user/projects
Anselm Farber's solution, involving uiop:native-namestring breaks on some pathnames that don't have native-namestrings, like the following:
(uiop:native-namestring "~/Music/[Video] performance.mp4")
==>
The pathname #P"~/Music/[Video] performance.mp4"
does not have a native namestring because
of the :NAME component #<SB-IMPL::PATTERN (:CHARACTER-SET
. "Video")
" performance">.
[Condition of type SB-KERNEL:NO-NATIVE-NAMESTRING-ERROR]
Here is a direct solution that only uses pathname- functions:
(defun expand-user-homedir (f)
(let ((d (pathname-directory f)))
(if (and (eql (car d) :absolute)
(eql (cadr d) :home))
(make-pathname :directory (append (pathname-directory (user-homedir-pathname))
(cddr d))
:name (pathname-name f)
:type (pathname-type f))
f)))

How to define globally a user input as variable

Is there a way, in common lisp, to receive a user input, say "foo", and defvar a global variable *foo*?
For example (which does NOT work):
(defun global-name (s)
"Takes s and changes it to *s*"
(concatenate 'string "*" s "*"))
(defun add-global-var (var)
"defvars a global variable and adds it to *global-list*"
(let ((var-name (global-name var)))
(defvar var-name var)
(push var-name *global-list*)))
; Used like this:
(add-global-var "myvar")
In this case, the var-name is a string, and will not work with defvar.
Déjà vu... I asked these kinds of questions 20+ years ago ;-)
Your question
Yes, you can do that (but no, you do not want to!)
(defun add-global-var (var-name &optional (package *package*))
(let ((var (intern var-name package)))
(proclaim `(special ,var))
(push var *global-list*)))
Please see
proclaim
intern
*package*
Alternatively, you can use a macro as the other answer suggests - in
fact, symbol creation at macroexpansion time (which is part of
compilation) is a very common thing,
cf. gensym.
Your problem
There is little reason to do this though.
Global variables created at run time were not available at compile time
and are, therefore, pretty useless.
Why do you want to do this?
If you want to map strings to values, you are much better off using an
equal hash table.
If you want to integrate with read,
you should call it while binding
*package*
to your internal temp package and then use
symbol-value
to store and retrieve values.
You will use intern to
map "variable names" to the symbols.
This is most likely a XY problem since it's very unusual to need to make a variable with a name made up in runtime. It's very common in compile time, but not runtime. #coredump has already covered compile time macros if that is what you are after.
Here is how you do it though:
(defun add-global-var (var)
"defvars a global variable and adds it to *global-list*"
(let ((var-name (intern (string-upcase (global-name var)))))
(set var-name var)
(push var-name *global-list*)))
set is deprecated, but I doubt it will ever be removed. Implementations might not be able to run as fast though since this is like messing with internals.
Since the names are not from source you you have no good use for the bidnings. because of this I would rather use a hash:
(defvar *bindings* (make-hash-table :test #'eq))
(defun add-binding (var)
(let ((var-name (intern (string-upcase (global-name var)))))
(setf (gethash var-name *bindings*) var)
*bindings*))
A reason to do this is as a part of your own little interpreter symbol table or something. You don't need a list of them since you can get all the keys from the hash as well as get the bound values.
Yes, with a macro:
(defvar *global-list* nil)
I changed global-name so that it also accepts symbols, to avoid thinking about whether the string should be upcased or not. With a symbol, the case is given by readtable-case (you can use uninterned symbols if you want to avoid polluting packages).
(defun global-name (name)
(check-type name (or string symbol))
(intern
(concatenate 'string "*" (string name) "*")))
I named the macro defvar*:
(defmacro defvar* (name)
`(push
(defvar ,(global-name name) ',name)
*global-list*))
Tests:
CL-USER> (defvar* #:foo)
(*FOO*)
CL-USER> (defvar* #:bar)
(*BAR* *FOO*)
Note:
You can also add an optional package argument like in #sds's answer, that's better.

LISP - Make new unique symbol

In a Common Lisp program, I want to find a way to generate a new symbol that is not in use in the program at the time. I am aware of the (gensym) function, but this makes symbols that may already be present in the program. I have some understanding that I need to intern the symbol, so I tried this:
(defun new-symbol () (intern (symbol-name (gensym))))
Which seems to get halfway to the answer. For instance,
[1]> (new-symbol)
G3069
NIL
[2]> (new-symbol)
G3070
NIL
[3]> (defvar a 'G3071)
A
[4]> (new-symbol)
G3071
:INTERNAL
As you can see, the function seems to recognize that the symbol 'G3071' is already in use elsewhere, but I don't know how to get it to generate a new symbol if that is the case.
I am aware of the (gensym) function, but this makes symbols that may already be present in the program.
No, it doesn't. It creates symbols that aren't interned in any package. The documentation says (emphasis added):
Function GENSYM
Syntax:
gensym &optional x &Rightarrow; new-symbol
Arguments and Values:
x—a string or a non-negative integer. Complicated defaulting
behavior; see below.
new-symbol—a fresh, uninterned symbol.
You can also use make-symbol to create a symbol that's not interned in any package. It's documentation summary (pretty much identical to gensym's):
Function MAKE-SYMBOL
Syntax:
make-symbol name &Rightarrow; new-symbol
Arguments and Values:
name—a string.
new-symbol—a fresh, uninterned symbol.
Regarding your second point:
I have some understanding that I need to intern the symbol, so I tried this:
No, if you want a fresh symbol, then you probably don't want to be interning anywhere. Interning is the process whereby you take a string (not a symbol) and get the symbol with the given name within a particular package. If you call intern with the same symbol name and package twice, you'll get back the same symbol, which is what you're trying to avoid.
CL-USER> (defparameter *a* (intern "A"))
*A*
CL-USER> (eq *a* (intern "A"))
T
Since gensym generates the name of the fresh symbol using *gensym-counter*, if you take the name from the gensym symbol and intern it somewhere, you could get the same symbol if someone modifies the value of *gensym-counter*. E.g.:
(let ((counter *gensym-counter*) ; save counter value
(s1 (gensym))) ; create a gensym (s1)
(setf *gensym-counter* counter) ; reset counter value
(let ((s2 (gensym))) ; create a gensym (s2)
(list s1
s2
(eq s1 s2)
(symbol-name s1)
(symbol-name s2)
(string= (symbol-name s1)
(symbol-name s2)))))
; (#:G1037 #:G1037 NIL ; different symbols
; "G1037" "G1037" T) ; same name

Common Lisp: defpackage and exporting symbols that are created programmaticaly

how would you / should you export symbols from a package, when you have not yet created them at the time of calling the defpackage macro?
(defpackage :package-a
(:use :cl)
(:export :fruit-type :animal-type :orange :apple :peach :cat :dog))
(deftype fruit-type () '(member ORANGE APPLE PEACH))
(deftype animal-type () '(member CAT DOG))
(defparameter *other-symbol-names*
'("A1" "A2" "B1" "B2")) ;imagine a longer list here
;with names generated by a function
(defparameter *other-symbols*
(mapcar #'(lambda (sym-name)
(import (make-symbol sym-name))
(find-symbol sym-name))
*other-symbol-names*))
(mapcar #'export *other-symbols*)
(setf A1 32 A2 33 B1 34 B2 35)
also there is another package
(defpackage :package-b
(:use :cl :package-a))
(in-package :package-b)
(format nil "~a ~a ~a ~a" |A1| |A2| |B1| |B2|)
I have read in "The Complete Idiot’s Guide to Common Lisp Packages" that
"Now that you’ve learned all about the myriad functions and macros that can be
used to manipulate packages you shouldn’t really be using any of them. Instead,
all of the functionality of IMPORT, EXPORT, SHADOW, etc. is all rolled up in a
single macro called DEFPACKAGE, which is what you should use for real (non-
prototype) code."
Is there a code smell in my above code? Also, how would you export the other symbols (cat dog animal-type, etc. -- there are many of them) to avoid duplication?
It's hard to say much without knowing more about your intent and requirements, but in many situations it would be better to have one or more hash tables (or similar) which contain your dynamically generated objects, and then export symbol(s) for your hash table(s).
Here's a hand-wavy example of how this can work. If you can edit and add some more information about your requirements and constraints I'll see if I can be more help.
(in-package :cl)
(defpackage :package-a
(:use :cl)
(:export *objects* put get)
(:shadow get))
(in-package :package-a)
(defvar *objects* (make-hash-table)
"Container for dynamically generated objects we want to expose to the
package's user.")
(defun put (name obj)
(setf (gethash name *objects*) obj))
(defun get (name &optional default)
(gethash name *objects* default))
;; Your code can put arbitrary objects into the hash table
(put :foo (lambda () :a-thunk))
(put :bar (lambda () :another))
;; And your users can retrieve them
(in-package :cl-user)
(use-package :package-a)
(funcall (get :foo)) ;; => :a-thunk
I used keywords for the names rather than symbols because keywords aren't local to packages (or, more specifically, they're all local to the keyword package. If you were to instead use 'foo and 'bar you'd be back to needing to export those symbols, or your user would need to use the package designator when refer to them (e.g. (get 'package-a::foo)).
You can also use strings as keys, though in that case you would want to create the table with (make-hash-table :test 'equal). The default hash table test is #'eql, which doesn't compare strings appropriately. Comparing keywords with #'eql is faster than comparing strings with #'equal (because keywords are a simple pointer comparison, as opposed to the character-by-character comparison necessary for strings) but the difference is likely insignificant unless you have specific reason to think otherwise.
This approach provides a better interface for your users, because now your have defined entry points, the opportunity for docstrings, defaults, and easier exploration at the REPL.

Resources