|
@@ -15,28 +15,6 @@ lexically bound to the current subclass' class-name."
|
15
|
15
|
(let ((,klasses (,all-subclasses (find-class ',class))))
|
16
|
16
|
(loop for ,var in ,klasses do ,@body)))))
|
17
|
17
|
|
18
|
|
-(defun fmt (fmt-str args)
|
19
|
|
- "A convenient FORMAT interface for string building."
|
20
|
|
- (apply 'format nil fmt-str args))
|
21
|
|
-
|
22
|
|
-(defun rel-path (base path &rest args)
|
23
|
|
- "Take a relative PATH and return the corresponding pathname beneath BASE.
|
24
|
|
-If ARGS is provided, use (fmt path args) as the value of PATH."
|
25
|
|
- (merge-pathnames (fmt path args) base))
|
26
|
|
-
|
27
|
|
-(defun app-path (path &rest args)
|
28
|
|
- "Return a relative path beneath coleslaw."
|
29
|
|
- (apply 'rel-path coleslaw-conf:*basedir* path args))
|
30
|
|
-
|
31
|
|
-(defun run-program (program &rest args)
|
32
|
|
- "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
|
33
|
|
-use (fmt program args) as the value of PROGRAM."
|
34
|
|
- (inferior-shell:run (fmt program args) :show t))
|
35
|
|
-
|
36
|
|
-(defun update-symlink (path target)
|
37
|
|
- "Update the symlink at PATH to point to TARGET."
|
38
|
|
- (run-program "ln -sfn ~a ~a" target path))
|
39
|
|
-
|
40
|
18
|
(defmacro do-files ((var path &optional extension) &body body)
|
41
|
19
|
"For each file on PATH, run BODY. If EXTENSION is provided, only run BODY
|
42
|
20
|
on files that match the given extension."
|
|
@@ -48,14 +26,15 @@ on files that match the given extension."
|
48
|
26
|
,@body)))
|
49
|
27
|
`,body))))
|
50
|
28
|
|
51
|
|
-(defun exit ()
|
52
|
|
- "Exit the lisp system returning a 0 status code."
|
53
|
|
- #+sbcl (sb-ext:quit)
|
54
|
|
- #+ccl (ccl:quit)
|
55
|
|
- #+ecl (si:quit)
|
56
|
|
- #+cmucl (ext:quit)
|
57
|
|
- #+clisp (ext:quit)
|
58
|
|
- #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
|
|
29
|
+(defmacro with-current-directory (path &body body)
|
|
30
|
+ "Change the current OS directory to PATH and execute BODY in
|
|
31
|
+an UNWIND-PROTECT, then change back to the current directory."
|
|
32
|
+ (alexandria:with-gensyms (old)
|
|
33
|
+ `(let ((,old (current-directory)))
|
|
34
|
+ (unwind-protect (progn
|
|
35
|
+ (setf (current-directory) ,path)
|
|
36
|
+ ,@body)
|
|
37
|
+ (setf (current-directory) ,old)))))
|
59
|
38
|
|
60
|
39
|
(defun current-directory ()
|
61
|
40
|
"Return the operating system's current directory."
|
|
@@ -75,20 +54,37 @@ on files that match the given extension."
|
75
|
54
|
#+clisp (ext:cd path)
|
76
|
55
|
#-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
|
77
|
56
|
|
78
|
|
-(defmacro with-current-directory (path &body body)
|
79
|
|
- "Change the current OS directory to PATH and execute BODY in
|
80
|
|
-an UNWIND-PROTECT, then change back to the current directory."
|
81
|
|
- (alexandria:with-gensyms (old)
|
82
|
|
- `(let ((,old (current-directory)))
|
83
|
|
- (unwind-protect (progn
|
84
|
|
- (setf (current-directory) ,path)
|
85
|
|
- ,@body)
|
86
|
|
- (setf (current-directory) ,old)))))
|
|
57
|
+(defun exit ()
|
|
58
|
+ "Exit the lisp system returning a 0 status code."
|
|
59
|
+ #+sbcl (sb-ext:quit)
|
|
60
|
+ #+ccl (ccl:quit)
|
|
61
|
+ #+ecl (si:quit)
|
|
62
|
+ #+cmucl (ext:quit)
|
|
63
|
+ #+clisp (ext:quit)
|
|
64
|
+ #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
|
|
65
|
+
|
|
66
|
+(defun fmt (fmt-str args)
|
|
67
|
+ "A convenient FORMAT interface for string building."
|
|
68
|
+ (apply 'format nil fmt-str args))
|
|
69
|
+
|
|
70
|
+(defun rel-path (base path &rest args)
|
|
71
|
+ "Take a relative PATH and return the corresponding pathname beneath BASE.
|
|
72
|
+If ARGS is provided, use (fmt path args) as the value of PATH."
|
|
73
|
+ (merge-pathnames (fmt path args) base))
|
|
74
|
+
|
|
75
|
+(defun app-path (path &rest args)
|
|
76
|
+ "Return a relative path beneath coleslaw."
|
|
77
|
+ (apply 'rel-path coleslaw-conf:*basedir* path args))
|
|
78
|
+
|
|
79
|
+(defun run-program (program &rest args)
|
|
80
|
+ "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
|
|
81
|
+use (fmt program args) as the value of PROGRAM."
|
|
82
|
+ (inferior-shell:run (fmt program args) :show t))
|
|
83
|
+
|
|
84
|
+(defun update-symlink (path target)
|
|
85
|
+ "Update the symlink at PATH to point to TARGET."
|
|
86
|
+ (run-program "ln -sfn ~a ~a" target path))
|
87
|
87
|
|
88
|
88
|
(defun take-up-to (n seq)
|
89
|
89
|
"Take elements from SEQ until all elements or N have been taken."
|
90
|
90
|
(subseq seq 0 (min (length seq) n)))
|
91
|
|
-
|
92
|
|
-(defun make-pubdate ()
|
93
|
|
- "Make a RFC1123 pubdate representing the current time."
|
94
|
|
- (local-time:format-rfc1123-timestring nil (local-time:now)))
|