Преглед изворни кода

Merge pull request #56 from PuercoPop/misc-fixes

Misc fixes
Brit Butler пре 10 година
родитељ
комит
c7d418b896
4 измењених фајлова са 22 додато и 23 уклоњено
  1. 4 0
      src/packages.lisp
  2. 16 21
      src/util.lisp
  3. 1 1
      themes/hyde/post.tmpl
  4. 1 1
      themes/readable/post.tmpl

+ 4 - 0
src/packages.lisp

@@ -7,6 +7,10 @@
7 7
   (:import-from :cl-fad #:file-exists-p)
8 8
   (:import-from :closure-template #:compile-template)
9 9
   (:import-from :local-time #:format-rfc1123-timestring)
10
+  (:import-from :uiop #:getcwd
11
+                      #:chdir
12
+                      #:ensure-directory-pathname
13
+                      #:directory-exists-p)
10 14
   (:export #:main
11 15
            #:preview
12 16
            #:*config*

+ 16 - 21
src/util.lisp

@@ -30,33 +30,28 @@ BODY on files that match the given extension."
30 30
                                         #',extension-p
31 31
                                         (constantly t))))))
32 32
 
33
+(define-condition directory-does-not-exist (error)
34
+  ((directory :initarg dir :reader dir))
35
+  (:report (lambda (c stream)
36
+             (format stream "The directory '~A' does not exist" (dir c)))))
37
+
38
+(defun (setf getcwd) (path)
39
+  "Change the operating system's current directory to PATH."
40
+  (setf path (ensure-directory-pathname path))
41
+  (or (and (directory-exists-p path)
42
+           (chdir path))
43
+      (error 'directory-does-not-exist :dir path))
44
+  path)
45
+
33 46
 (defmacro with-current-directory (path &body body)
34 47
   "Change the current directory to PATH and execute BODY in
35 48
 an UNWIND-PROTECT, then change back to the current directory."
36 49
   (alexandria:with-gensyms (old)
37
-    `(let ((,old (current-directory)))
50
+    `(let ((,old (getcwd)))
38 51
        (unwind-protect (progn
39
-                         (setf (current-directory) ,path)
52
+                         (setf (getcwd) ,path)
40 53
                          ,@body)
41
-         (setf (current-directory) ,old)))))
42
-
43
-(defun current-directory ()
44
-  "Return the operating system's current directory."
45
-  #+sbcl (sb-posix:getcwd)
46
-  #+ccl (ccl:current-directory)
47
-  #+ecl (si:getcwd)
48
-  #+cmucl (unix:unix-current-directory)
49
-  #+clisp (ext:cd)
50
-  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
51
-
52
-(defun (setf current-directory) (path)
53
-  "Change the operating system's current directory to PATH."
54
-  #+sbcl (sb-posix:chdir path)
55
-  #+ccl (setf (ccl:current-directory) path)
56
-  #+ecl (si:chdir path)
57
-  #+cmucl (unix:unix-chdir (namestring path))
58
-  #+clisp (ext:cd path)
59
-  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
54
+         (setf (getcwd) ,old)))))
60 55
 
61 56
 (defun exit ()
62 57
   "Exit the lisp system returning a 0 status code."

+ 1 - 1
themes/hyde/post.tmpl

@@ -6,7 +6,7 @@
6 6
   <div class="tags">{\n}
7 7
     {if $post.tags}
8 8
       Tagged as {foreach $tag in $post.tags}
9
-        <a href="../tag/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>{nil}
9
+        <a href="{$config.domain}/tag/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>{nil}
10 10
           {if not isLast($tag)},{sp}{/if}
11 11
       {/foreach}
12 12
     {/if}

+ 1 - 1
themes/readable/post.tmpl

@@ -6,7 +6,7 @@
6 6
   <p>
7 7
     {if $post.tags}
8 8
       Tagged as {foreach $tag in $post.tags}
9
-        <a href="../tag/{$tag.slug}{$config.pageExt}">{$tag.name}</a>{nil}
9
+        <a href="{$config.domain}/tag/{$tag.slug}{$config.pageExt}">{$tag.name}</a>{nil}
10 10
           {if not isLast($tag)},{sp}{/if}
11 11
       {/foreach}
12 12
     {/if}