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))))
Related
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.
While trying to work through cl-sdl2-tutorial, I'm having trouble loading a bitmap due to a wrong current working directory.
I'd like to get a proper solution to the problem using relative path names.
A minimal working example:
Having modified the code of example two from above mentioned tutorial.
(defpackage #:sdl2-tutorial-2
(:use :common-lisp)
(:export :main))
(in-package :sdl2-tutorial-2)
(defparameter *screen-width* 640)
(defparameter *screen-height* 480)
(defmacro with-window-surface ((window surface) &body body)
`(sdl2:with-init (:video)
(sdl2:with-window (,window
:title "SDL2 Tutorial"
:w *screen-width*
:h *screen-height*
:flags '(:shown))
(let ((,surface (sdl2:get-window-surface ,window)))
,#body))))
(defun main(&key (delay 2000))
(format t " cwd: ~a, ~% dpd: ~a, ~& e-p: ~a, ~% pf: ~a, ~& load: ~a"
(sb-posix:getcwd)
*default-pathname-defaults*
(uiop:file-exists-p "hello_world.bmp")
(probe-file "hello_world.bmp")
(sdl2:load-bmp "hello_world.bmp"))
(with-window-surface (window screen-surface)
(let ((image (sdl2:load-bmp "hello_world.bmp")))
(break "1 here with ~a~%" image)
(setf image (sdl2:load-bmp "hello_world.bmp"))
(break "2 here with ~a~%" image)
(break "3 error: ~a~%" (sdl2-ffi.functions:sdl-get-error))
(sdl2:blit-surface image
nil
screen-surface
nil)
(sdl2:update-window window)
(sdl2:with-event-loop (:method :poll)
(:quit () t)
(:idle ()
(sdl2:delay delay))))))
Before compiling above code and running (main), I changed working directory in the REPL, via:
(sb-posix:chdir (truename "/test/cl-sdl2-tutorial/2/"))
(setf *default-pathname-defaults* (truename "/test/cl-sdl2-tutorial/2/"))
The above code prints, as expected, when running (main) in the REPL:
SDL2-TUTORIAL-2> (sdl2-tutorial-2:main)
0: (SDL2-TUTORIAL-2:MAIN)
cwd: /test/cl-sdl2-tutorial/2,
dpd: /test/cl-sdl2-tutorial/2/,
e-p: /test/cl-sdl2-tutorial/2/hello_world.bmp,
pf: /test/cl-sdl2-tutorial/2/hello_world.bmp,
load: #<SDL-SURFACE {#X7F5CBC018DD0}>
Problem:
The bitmap can not be found and therefore not loaded.
Calls to (sdl2:load-bmp "hello_world.bmp") always return a a zero pointer (#<SDL-SURFACE {#X00000000}>) and breakpoint 3 states:
3 error: Couldn't open /home/jue/hello_world.bmp
but evaling (sdl2:load-bmp "hello_world.bmp") during a break from breakpoints 1 or 2 or 3, is successful and continuing (main) displays the picture.
Questions:
Why is sdl2:load-bmp using the "wrong" working directory and why is it using the "correct" working directory during breakpoints?
How to make sdl2:load-bmp use the wanted working directory (instead of "/home/jue/") when using relative paths?
Remarks
(I'm using current released versions of sbcl, Emacs, sly on a Linux machine, if that matters. I'm only intermediate experienced with Common Lisp and its development environment, but advanced at elisp)
I suspect but don't know that the problem is that the sdl2 library is doing fanciness with threads, with the result that the working directory isn't what you think.
The solution to this in my experience is never to let the implementation second-guess you like that. In any case where there's some interface which says "do something to a file" give it an absolute pathname so it has no chance to do any thinking of its own. Do something like.
(defparameter *where-my-bitmaps-live* (merge-pathnames
(pathname "lib/bitmaps/")
(user-homedir-pathname)))
...
(defun load-a-bitmap (name)
(load-bmp (merge-pathnames (pathname name) *where-my-bitmaps-live*)))
And now it really has no excuse.
(You want to check that the above pathname-mergery is actually right: it seems to be for me but I forget the details of pathname rules every time I look away for more than a few minutes).
Thanks to Common Lisp's powerful macro system, I can write lots of code template to generate functions avoid writing redundant code manually. What's more, it can generate different code based on configure file, so I can implement many kinds of feature just apply different configure file.
However, I have no idea how to deliver the project (It's a library):
In my opinion, maybe every config file corresponds to a package?
For example, there is a common lisp file common.lisp, it generate different functions based different configure file in compile-time.
It reads a.conf in compile-time and generate functions for PackageA and reads config b.conf in compile-time for PackageB. But in-place statement must specify only one package, the common.lisp can't both in Package A and B.
By the way, I still can't find out a proper method to get the configure path of project (So I can read and use it in compile-time to generate functions) I have tried *load-truename* for it points to the cache path which contains .fasl file on SBCLv2.0.1. But it looks like the staic files are not contained in it, so it doesn't works.
For macro-expansion the thing you care about is compile time, not load time, and the variables you want are therefore *compile-file-pathname* &/or *compile-file-truename*. ASDF likes to stash compiled files (and hence the files being loaded) somewhere known to it, which you can turn off (I do) but defaultly they end up somewhere far from their sources.
Here's an example macro which should (I have not really tested it) let you enable debugging output on a per-file basis. In real life it would be better to cache the read of the config file/s but this is mildly fiddly to get right.
(declaim (inline mutter))
(defun mutter (format &rest arguments)
(declare (ignore format arguments))
(values))
(defmacro maybe-debugging (&body forms)
(let ((config-file (and *compile-file-truename*
(make-pathname :name "debug"
:type "cf"
:defaults *compile-file-truename*))))
(multiple-value-bind (debugging cond)
(if (and config-file (probe-file config-file))
(ignore-errors
(with-standard-io-syntax
(let ((*read-eval* nil))
(with-open-file (in config-file)
(values (assoc (pathname-name *compile-file-truename*)
(read in)
:test #'string-equal)
nil)))))
(values nil nil))
(when cond
(warn "bogons reading ~A for ~A: ~A"
config-file *compile-file-truename* cond))
(if debugging
`(flet ((mutter (format &rest arguments)
(apply #'format *debug-io* format arguments)))
,#forms)
`(progn
,#forms)))))
For the single-source-file-resulting-in-multiple-object-files you could do something like this (note this repeats a variant of the above code):
(eval-when (:load-toplevel :compile-toplevel :execute)
(defvar *package-compilation-configuration*
nil
"Compile-time configuration for a package")
(defun package-config-value (key &optional (default nil))
(getf *package-compilation-configuration* key default)))
(declaim (inline mutter))
(defun mutter (format &rest args)
(declare (ignore format args))
(values))
(defmacro with-muttering (&body forms)
(if (package-config-value ':mutter)
`(flet ((mutter (fmt &rest args)
(apply #'format *debug-io* fmt args)))
,#forms)
`(progn
,#forms)))
(defun compile-file-for-package (file package &rest kws
&key (output-file nil output-file-p)
&allow-other-keys)
(with-muttering
(let* ((sf-pathname (pathname file))
(package-file (make-pathname :name (string package)
:type "cf"
:defaults sf-pathname))
(the-output-file
(if output-file-p
output-file
(compile-file-pathname
(make-pathname :name (format nil "~A-~A"
(pathname-name sf-pathname)
package)
:defaults sf-pathname))))
(*package-compilation-configuration*
(if (probe-file package-file)
(with-standard-io-syntax
(mutter "~&Compile ~A -> ~A using ~A~%"
sf-pathname the-output-file package-file)
(let ((*read-eval* nil))
(with-open-file (in package-file)
(read in))))
(progn
(mutter "~&Compile ~A -> ~A (no package)~%"
sf-pathname the-output-file)
nil))))
(apply #'compile-file file
:output-file the-output-file
kws))))
Then (compile-file-for-package "x.lisp" "y") will compile x.lisp having read configuration for package "y".
To use something like this in anger you would need to integrate it with ASDF and I don't know how to do that.
An alternative idea is just to use symlinks for the source files, and have the filename-dependent configuration depend on the symlink name, not the target name.
For my case:
project-a.asd:
(asdf:defsystem #:project-a
:components ((:static-file "my-config-file.conf")
(:static-file "common.lisp") ; shared common lisp file
(:file "project-a-package")
(:file "project-a-setup")
;; other components
)
)
project-a-setup.lisp:
(in-package #:project-a)
(eval-when (:compile-toplevel)
(defvar *mypackage* (find-package 'project-a))
(defvar *source-home* (path:dirname *compile-file-truename*))
;; read configure file
(defparameter *myconf*
(with-open-file (stream (merge-pathnames *source-home* #P"my-config-file.conf"))
(read stream)))
)
(load (merge-pathnames *source-home* #P"common.lisp"))
common.lisp:
(let ((*package* *mypackage*))
;; intern symbol
)
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)))
I am trying to add to a program I am writing, a feature whereby everything printed to the console, also gets added to a log file. This much can be done with broadcast streams. The problem is that the program may also need to abruptly exit from within a leaf function, and when I do this, the log file does not get created. This is what I have so far:
(catch 'quit
(with-open-file (log-stream "log.txt"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(let ((*standard-output*
(make-broadcast-stream *standard-output* log-stream)))
(format t "abc~%")
(throw 'quit nil))))
When I run the above code (SBCL 1.4.2, Windows 7), the file log.txt does not get created. The same is true if I replace (throw 'quit nil) with (quit). However, if I remove that line altogether and just let the program exit by falling off the end of the file, the log file does get correctly created, which suggests it's a caching issue.
Is that the correct diagnosis? If so, is there a way to tell the compiler not to cache that file, or to exit with rather than without writing cached data?
This is the behaviour described in the standard for WITH-OPEN-FILE:
If a new output file is being
written, and control leaves abnormally, the file is aborted and the file system is left,
so far as possible, as if the file had never been opened.
The following explicitly closes the file:
(catch 'quit
(with-open-file (log-stream "/tmp/log.txt"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(let ((*standard-output* (make-broadcast-stream *standard-output* log-stream)))
(unwind-protect (progn
(format t "abc~%")
(throw 'quit nil))
(finish-output)
(close log-stream :abort nil)))))
The :abort nil value is the default one, it is made explicit here for the sake of the answer.