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)))
Related
I use a macro called use-db and change-to-path in a lot of my projects.
(defmacro use-db (db project-name &body query)
`(progn
(change-to-path ,project-name)
(clsql:connect ,db :database-type :sqlite3)
(unwind-protect (progn ,#query)
(clsql:disconnect :database ,db))))
(defmacro change-to-path (project-name)
`(uiop:chdir (merge-pathnames (write-to-string ,project-name) "/Users/vince/quicklisp/local-projects/")))
As you can see, change to path changes the repl dir. Then use-db reads the sqlite db from the root of the project folder. This works fine.
However, when I try to read a db as part of a route (easy-routes + hunchentoot):
(defroute test-file ("/results" :method :post)
()
(get-one-col-as-list-db #'first "firstname"))
(defun get-one-col-as-list-db (fn tablename)
(ki:use-db "new.db" 'custom-sender
(mapcar fn
(clsql:query
(concatenate 'string "Select * from " tablename)))))
I get the following error:
Error in SB-POSIX:CHDIR: No such file or directory (2)
without using the change-to-path macro, clsql function would note find the database.
Is there a better way to use sqlite (from the file system) and manage the pathing for specific db files?
To change the current working directory, temporarily, use uiop:with-current-directory:
(uiop:with-current-directory ("/tmp/")
(uiop:getcwd))
(edit) chdir has a side effect: it effectively changes the current working directory (uiop:getcwd), while with-current-directory doesn't, or it does but only temporarily for the code under it. For your sanity you want to avoid chdir's side effets (or I do, I want to work at a project root). It could have an effect on bare-bones Hunchentoot, if it looks at a www/ directory under the project root, but in your case I'm not sure.
Your use-db mimics a well-known pattern: get a resource, and be sure to release it in case of errors. These macros are often named "with-something", just like "with-current-directory". Does CLSQL have such a macro? It does: with-database.
Why is your change-to-path a macro? It can be a function that concatenates strings and calls chdir.
Inside use-db, "project-name" is an unknown variable. Look at the compiler warnings:
; caught WARNING:
; undefined variable: COMMON-LISP-USER::PROJECT-NAME
How do you use the two anyways?
Error in SB-POSIX:CHDIR: No such file or directory (2) […] without using the change-to-path macro
what is the directory it tries to go to? You'd have a tip on how things are not working.
I try to never rely on the process working directory, because from Common Lisp I am much happier using *default-pathname-defaults* (no side effects!). This is a special variable with a long name, and what I want is to use merge-pathnames in most of the cases, so I have this macro:
(defmacro with-path (pathname &body body)
`(let ((*default-pathname-defaults* (merge-pathnames ,pathname)))
,#body))
It is just a local binding of a special variable so unwinding is trivial, and it comes with all the benefits of CL pathnames (and some of its drawbacks but that's fine).
On the Posix side of things, programs want a native namestring so I also use this a lot:
(defun fullname (pathname)
(osicat:native-namestring (merge-pathnames pathname)))
I do also have a concept of projects in my environment so it looks as follows. Note that I try to carry the special variable until the last moment, until it needs to be given to other processes, like:
(within-project projects:my-project
(with-path "build/"
(run "make")))
Here run grabs the current *default-pathname-defaults* for its :directory argument (using sb-ext:run-program but this is a detail).
Since it is a pathname, some components can be wild too, if that makes sense in your use case. For example, you can avoid giving a ".db" suffix if you prefer:
(defmacro using-db ((name db) &body body)
`(with-path #P"*.db"
(with-database (,name (list (fullname ,db)) :database-type :sqlite3)
,#body)))
For example, here I enter the "/tmp/" directory and open database "test.db":
(with-path "/tmp/"
(using-db (database "test")
database)))
#<CLSQL-SQLITE3:SQLITE3-DATABASE /tmp/test.db CLOSED {100DD6CE63}>
Edit: with respect to the following code:
(uiop:chdir
(merge-pathnames (write-to-string project-name)
"/Users/vince/quicklisp/local-projects/")))
Note that you can use ASDF to access files relative to systems:
(asdf:system-relative-pathname :cl-ppcre "ppcre.lisp")
#P"..../quicklisp/software/cl-ppcre-20220220-git/ppcre.lisp"
Sounds deceptively easy. This doesn't work:
~/.sbclrc
(load #P"~/in-package.lisp")
~/in-package.lisp
(in-package 'stored-package)
The package change only applies to the file in-package.lisp itself.
Try different approach: store just the name.
(defmacro recall-package (&optional (filename #p"~/lisp-package.lisp"))
"IN-PACKAGE the contents of the FILENAME"
(let ((p (car (uiop:read-file-lines filename))))
`(in-package ,p)))
This works, but only from ~/.sbclrc. Files which it LOADs expand the macro within their own context, and so it doesn't work.
SBCL reads it's .sbclrc like this:
(restart-case
(flet ((process-init-file (kind specified-pathname default-function)
(awhen (or specified-pathname (funcall default-function))
(with-open-file (stream (if specified-pathname
(parse-native-namestring it)
(pathname it))
:if-does-not-exist nil)
(cond (stream
(sb-fasl::call-with-load-bindings
(lambda (stream kind) (load-as-source stream :context kind))
stream kind stream))
(specified-pathname
(cerror "Ignore missing init file"
"The specified ~A file ~A was not found."
kind specified-pathname)))))))
(unless no-sysinit
(process-init-file "sysinit" sysinit *sysinit-pathname-function*))
(unless no-userinit
(process-init-file "userinit" userinit *userinit-pathname-function*))
Using these fancy sb-fasl::call-with-load-bindings and sb-int:load-as-source yields similar results to the above.
You can't do this with load, because
load binds *readtable* and *package* to the values they held before loading the file.
Function load
This means that any changes made to the values of these variables within a file being loaded are local to the file. That's almost always a good thing. In particular it means that there is no way at all (or no portable way: if you had access to the guts of the dynamic binding mechanism of the implementation this might not be true) that any changes made to the current package (ie the dynamic value of *package*) can ever propagate up through calls to load.
If all you want to do is set the package based on some name in a file, then this is relatively easy, with something like the below:
(defpackage :empty-package
(:use))
(defun set-package-from-file (f)
(let ((pn
(with-standard-io-syntax
;; EP just in case the file does somehow manage to smash
;; *package*)
(let* ((ep (find-package :empty-package))
(*package* ep)
(*read-eval* nil))
(unwind-protect
(with-open-file (in f)
(string (read in)))
;; Clean up EP to avoid leakage
(do-symbols (s ep)
(unintern s ep)))))))
(let ((p (find-package pn)))
(unless p (error "no package ~A" pn))
(setf *package* p))))
This is probably both overly-protective and thus will contain some horrible unexpected bug which I should have thought about (I know it's not safe against interning symbols in other packages). However the idea is that the file contains a single string-designator which should be the package name.
If you had time on your hands you could fairly easily write a version of load which would not rebind *package* &c, and which would work for source files. I think you can't portably write one which would work for FASL files.
Here's one reason why the behaviour the language specifies is the right behaviour: it makes compilation a lot easier. Consider a file which contains:
(in-package ...)
(defun foo (...) ...)
(load ...)
(defun bar (...)
(foo ...)
...)
If *package* could propagate up through load then compiling this file would be, at best, interesting.
This question is somewhat related to an earlier one on programmatically generating symbol macros. I'm using that function in a convenience macro that throws undefined variable warnings. This macro and function:
(defmacro define-data (d body &optional doc)
(if (and doc (not (stringp doc))) (error "Documentation is not a string"))
`(let* ((d-str (string ',d))
(old-package *package*)
(*package* (if (find-package d-str) ;exists?
(find-package d-str) ;yes, return it
(make-package d-str)))) ;no, make it
;; Should we have an eval-when (:compile-toplevel) here?
(defparameter ,d ,body ,doc)
(export ',d old-package)
(define-column-names ,d)))
(defun define-column-names (d)
(maphash #'(lambda (key index)
(eval `(cl:define-symbol-macro ,key (cl:aref (columns ,d) ,index))))
(ordered-keys-table (slot-value d 'ordered-keys))))
are intended to be like defparameter, but additionally set up a few niceties for the user by defining:
a package with the name of d
a parameter in the current package with the data that will be sucked in by body
symbol-macros in package d for access to the individual data vectors
If I use defparameter from the REPL, and then call define-column-names, all is well. However when using the macro I get:
; in: DEFINE-COLUMN-NAMES FOO
; (DEFINE-COLUMN-NAMES CL-USER::FOO)
;
; caught WARNING:
; undefined variable: CL-USER::FOO
I suspect that this is because the compiler has no way of knowing that FOO will actually be defined when define-symbol-macro is called. Everything works fine, but I don't want the warning to frighten users, so am thinking of suppressing it. I hate suppressing warnings though, so thought I'd come here for a second opinion.
EDIT: I've marked an answer correct because it does correctly answer the question as asked. For an answer to the problem see my comments.
My answer to the 'when to muffle warnings' question in the title is: if it's your own code then never, under any circumstances. If it is someone else's code, then rewrite it not to warn unless you can't.
As to solving the problem I haven't thought about this hard enough, but the problem is that you definitely want the defparameter to be at top-level so the compiler can see it, and it can't really be if it's inside a let. But you can raise it to toplevel trivially since it depends on nothing inside the let.
I am then pretty certain that you want the rest of the macro to happen at compile time, because you definitely want the symbol-macros available at compile-time. So an attempt at the first macro would be (note I've fixed the handling of the docstring: (defparameter foo 1 nil) is bad):
(defmacro define-data (d body &optional doc)
(when (and doc (not (stringp doc)))
(error "Documentation is not a string"))
`(progn
(defparameter ,d ,body ,#(if doc (list doc) '()))
(eval-when (:compile-toplevel :load-toplevel :execute)
(let* ((d-str (string ',d))
(old-package *package*)
(*package* (if (find-package d-str) ;exists?
(find-package d-str) ;yes, return it
(make-package d-str)))) ;no, make it
(export ',d old-package)
(define-column-names ,d)))))
As a side note: although I think the fact that programmatically defining symbol macros is hard because CL left that out for some reason, I think I'd personally use some other approach rather than this, because eval is just so horrid. That's just me however: if you want to do this you do need eval I think (it is very rare that this is true!).
I am not sure exactly how define-columns-names works so I replaced it with a stub function that returns d.
Note also that you can use check-type and should try not injecting symbols in generated code, this introduces potential variable capture that can be avoided with gensym.
As far as I know you cannot use eval-when as suggested by your comment (see Issue EVAL-WHEN-NON-TOP-LEVEL Writeup for details).
But I have no warning if I declare the symbol as being special around the call.
(defmacro define-data (d body &optional doc)
(check-type doc (or null string))
(check-type d symbol)
(let ((d-str (string d)))
(alexandria:with-gensyms (old-package)
`(let* ((,old-package *package*)
(*package* (if (find-package ,d-str) ;exists?
(find-package ,d-str) ;yes, return it
(make-package ,d-str)))) ;no, make it
(defparameter ,d ,body ,doc)
(export ',d ,old-package)
(locally (declare (special ,d))
(define-column-names ,d))))))
It is also a bit strange that you expand into a call to define-column-names, which in turns evaluated a form built at runtime. I think it might be possible to do all you want during macroexpansion time, but as said earlier what you are trying to do is a bit unclear to me. What I have in mind is to replace define-column-names by:
,#(expand-column-names-macros d)
... where expand-column-names-macros builds a list of define-symbol-macro forms.
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.
I want to provide additional information to the user during a restart-case for missing input files.
Is there a portable way to print out the files in the current directory?
Please take a look at File System Concepts, specifically at directory.
E.g.,
use (directory "~/*") to get the list of files in your home,
use (directory "~/*/") to get the list of directories in your home,
and (directory "~/**/*") to get the list of all files in all subdirectoris in your home
Note that directory may take implementation-specific arguments like :full.
If you are using asdf (you should!), you might want to take a look at uiop which comes with it.
PS. If your implementation does not support ~ in pathname to refer to the home directory, you can use user-homedir-pathname instead.
The reference to uiop was the hint I needed. This is what I use now in my test case and which works perfectly for me:
(defun file-is-missing ()
(let* ((cwd (uiop:getcwd))
(files (uiop:directory-files cwd)))
(format t "~&Current directory: ~a~%" cwd)
(dolist (file files)
(format t "~&~3T~a" file))
(format t "~&Provide new file: ")
(list (read-line))))
(defun read-file (file)
(restart-case
(with-open-file (s file :direction :input :if-does-not-exist :error)
(do ((l (read-line s) (read-line s nil 'eof)))
((eq l 'eof) "Reached end of file.")
(format t "~&*** ~A~%" l)))
(New-File (filename)
:interactive file-is-missing
(read-file filename))))