refactored class name matching code

added class-name-p function to util
refactored incremental plugin process-change and documents purge-all
to use class-name-p when matching against exact class names
This commit is contained in:
Colin M. Strickland 2015-01-04 15:23:33 +00:00
parent 7d26e2bb5a
commit 4b0819c288
3 changed files with 15 additions and 12 deletions

View file

@ -59,14 +59,11 @@
(:method :around (status path &key)
(let ((extension (pathname-type path))
(ctypes (all-subclasses (find-class 'content))))
;; This feels way too clever. I wish I could think of a better option.
(flet ((class-name-p (x class)
(string-equal x (symbol-name (class-name class)))))
;; If the updated file's extension doesn't match one of our content types,
;; we don't need to mess with it at all. Otherwise, since the class is
;; annoyingly tricky to determine, pass it along.
(when-let (ctype (find extension ctypes :test #'class-name-p))
(call-next-method status path :ctype ctype))))))
;; If the updated file's extension doesn't match one of our content types,
;; we don't need to mess with it at all. Otherwise, since the class is
;; annoyingly tricky to determine, pass it along.
(when-let (ctype (find extension ctypes :test #'class-name-p))
(call-next-method status path :ctype ctype)))))
(defmethod process-change ((status (eql :deleted)) path &key)
(let ((old (find-content-by-path path)))

View file

@ -75,7 +75,8 @@ use it as the template passing any RENDER-ARGS."
(defun purge-all (doc-type)
"Remove all instances of DOC-TYPE from memory."
(dolist (obj (find-all doc-type
(lambda (d) (equal (symbol-name (class-name (class-of d)))
(symbol-name doc-type)))))
(remhash (page-url obj) *site*)))
(flet ((matches-class-name-p (x)
(class-name-p (symbol-name doc-type)
(class-of x))))
(dolist (obj (find-all doc-type #'matches-class-name-p))
(remhash (page-url obj) *site*))))

View file

@ -98,3 +98,8 @@ in the git repo since REVISION."
(cl-ppcre:split "\\s+" str)))
(let ((cmd (format nil "git diff --name-status ~A HEAD" revision)))
(mapcar #'split-on-whitespace (inferior-shell:run/lines cmd)))))
(defun class-name-p (name class)
"True if the specified string is the name of the class provided"
;; This feels way too clever. I wish I could think of a better option.
(string-equal name (symbol-name (class-name class))))