Added CTYPE Registry system for content extensions by plugins. Added

metadata plugin for testing content modifier plugins.

coleslaw.asd

@@ -22,7 +22,6 @@
                (:file "themes")
                (:file "documents")
                (:file "content")
-               (:file "posts")
                (:file "indexes")
                (:file "feeds")
                (:file "coleslaw"))

docs/plugin-use.md

@@ -39,6 +39,34 @@
 
 **Example**: `(gh-pages :cname t)`
 
+## SEO and Social Metadata
+
+**Description**: Adds description and keywords metadata for SEO purposes.
+  Adds both Open Graph and Twitter Cards metadata for sharing posts as well.
+  `:twitter` keyword argument sets "site" property of Twitter.
+  Twitter Card specific metadata will be omitted if this property is not set.
+  `:card` keyword argument sets the type of Twitter card created.
+  Possible types are `:summary` and `:image`. Defaults to `:summary`.
+  
+  Five *optional* tags for post file header are added.
+
+  `keywords:` comma, seperated, seo, keywords.
+  They will be generated from tags if empty.
+
+  `description:` Description to be used in SEO and
+  Open Graph description tags. If empty, Open Graph description will be generated
+  from content while SEO description metadata will be omitted.
+
+  `image:` either an absolute (`http://www.example.com/image.png`)
+  or a root-relative (`/static/image.png`) image URL.
+
+  `card:` Overrides Twitter Card type defined in plugin activation.
+  Possible values are either `image` or `summary`.
+
+  `creator:` Twitter username of the content creator.
+
+**Example**: `(metadata :twitter "twitter_account" :card :summary)`
+
 ## Incremental Builds
 
 **Description**: Primarily a performance enhancement. Caches the

plugins/metadata.lisp

@@ -0,0 +1,94 @@
+(eval-when (:compile-toplevel :load-toplevel)
+  (ql:quickload 's-xml))
+
+(defpackage :coleslaw-metadata
+  (:use :cl :coleslaw)
+  (:import-from :coleslaw
+                #:title
+                #:domain
+                #:tag-name
+                #:page-url
+                #:make-keyword
+                #:content-tags
+                #:content-text)
+    (:import-from :s-xml
+                #:xml-parser-state
+                #:start-parse-xml)
+    (:export #:enable))
+
+(in-package :coleslaw-metadata)
+
+(defmodifier metadata (post) ()
+  ((keywords :initarg :keywords :reader keywords-of)
+   (description :initarg :description :reader description-of)
+   (image :initarg :image :reader image-of)
+   (card :initarg :card :reader card-format)
+   (creator :initarg :creator :reader creator-of))
+  (:default-initargs
+   :keywords nil
+   :description nil
+   :image nil
+   :card nil
+   :creator nil))
+
+(defmethod initialize-instance :after ((object metadata) &key)
+  (with-slots (card) object
+    (setf card (if card (make-keyword (string-upcase card))))))
+
+(defparameter *description-length* 200)
+
+(defvar *metadata-header*
+  "
+<meta name=\"keywords\" content=\"~A\" />~@[
+<meta name=\"description\" content=\"~A\" />~]~:[~*~*~;~:*
+<meta name=\"twitter:site\" content=\"@~A\" />
+<meta name=\"twitter:card\" content=\"~:[summary~;summary_large_image~]\" />~@[
+<meta name=\"twitter:creator\" content=\"@~A\" />~]~]
+<meta property=\"og:title\" content=\"~A\" />
+<meta property=\"og:site_name\" content=\"~A\" />
+<meta property=\"og:url\" content=\"~A\" />
+<meta property=\"og:description\" content=\"~A\" />~@[
+<meta property=\"og:image\" content=\"~A\" />~]
+")
+
+(defun remove-markup (text)
+  (with-input-from-string (in text)
+    (let* ((state (make-instance 'xml-parser-state
+                                 :text-hook #'(lambda (string seed) (cons string seed))))
+           (result (start-parse-xml in state)))
+      (apply #'concatenate 'string (nreverse result)))))
+
+(defun shorten-text (text)
+  (if (< *description-length* (length text))
+      (subseq text 0 (- *description-length* 1)) text))
+
+(defun compile-description (text)
+  (shorten-text (remove #\" (remove-markup text))))
+
+(defun root-relative-url-p (url)
+  (eq (elt url 0) #\/))
+
+(defun compile-url (url)
+  (if (root-relative-url-p url)
+      (concatenate 'string (domain *config*) url)
+      url))
+
+(defun compile-metadata (post twitter card)
+  (format nil *metadata-header*
+          (or (keywords-of post)
+              (format nil "~{~A~^, ~}" (mapcar #'tag-name (content-tags post))))
+          (description-of post)
+          twitter
+          (eq (or (card-format post) card) :image)
+          (creator-of post)
+          (title-of post)
+          (title *config*)
+          (concatenate 'string (domain *config*) "/" (namestring (page-url post)))
+          (or (description-of post)
+              (compile-description (content-text post)))
+          (when (image-of post) (compile-url (image-of post)))))
+
+(defun enable (&key twitter card)
+  (flet ((inject-p (x)
+           (when (typep x 'metadata) (compile-metadata x twitter card))))
+    (add-injection #'inject-p :head)))

plugins/posts.lisp

@@ -1,6 +1,25 @@
-(in-package :coleslaw)
+(defpackage :coleslaw-posts
+  (:use :cl :coleslaw)
+  (:import-from :coleslaw
+                #:compute-url
+                #:make-keyword
+                #:by-date
+                #:url
+                #:format
+                #:text
+                #:author
+                #:content
+                #:slugify
+                #:domain
+                #:tag-name
+                #:page-url
+                #:content-tags
+                #:content-text)
+  (:export #:enable))
 
-(defclass post (content)
+(in-package :coleslaw-posts)
+
+(defcontent post t
   ((title  :initarg :title  :reader title-of)
    (author :initarg :author :reader author-of)
    (format :initarg :format :reader post-format))
@@ -22,3 +41,5 @@
 (defmethod publish ((doc-type (eql (find-class 'post))))
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
      while post do (write-document post nil :prev prev :next next)))
+
+(defun enable ())

src/config.lisp

@@ -39,6 +39,12 @@
 (defparameter *config* nil
   "A variable to store the blog configuration and plugin settings.")
 
+(defun ensure-plugin (plugin)
+  "Ensures a specific plugin exists in the PLUGINS slot of *CONFIG*"
+  (pushnew plugin
+           (slot-value *config* 'plugins)
+           :key #'car))
+
 (define-condition plugin-conf-error ()
   ((plugin  :initarg :plugin :reader plugin)
    (message :initarg :message :reader message))
@@ -79,9 +85,10 @@ doesn't exist, use the .coleslawrc in the home directory."
 
 (defun load-config (&optional (repo-dir ""))
   "Find and load the coleslaw configuration from .coleslawrc. REPO-DIR will be
-preferred over the home directory if provided."
+preferred over the home directory if provided. Ensure posts plugin is loaded for backwards compatibility."
   (with-open-file (in (discover-config-path repo-dir) :external-format :utf-8)
     (let ((config-form (read in)))
       (setf *config* (construct 'blog config-form)
             (repo-dir *config*) repo-dir)))
+  (ensure-plugin '(posts)) ;;  Ensure posts plugin.
   (load-plugins (plugins *config*)))

src/content.lisp

@@ -1,5 +1,91 @@
 (in-package :coleslaw)
 
+;; Ctype Registry
+
+;; (defvar *ctype-registry* '((post :indexable t
+;;                                  :superclasses nil)))
+(defvar *ctype-registry* nil
+  "Registry of CTYPE records. Each record is a LIST. The CAR of each LIST is the CTYPE name. The CDR is a PLIST of CTYPE attributes.")
+
+(defun ensure-ctype-record (ctype
+                              &key
+                                (indexable nil)
+                                (superclasses nil))
+  "Ensure a specific CTYPE record exists in *CTYPE-REGISTRY*. Do not change record if exists. Add record with specified parameters if absent."
+  (unless (assoc ctype *ctype-registry*)
+      (pushnew (list ctype
+                   :indexable indexable
+                   :superclasses superclasses)
+             *ctype-registry*
+             :key #'car)))
+
+(defun get-ctype-attributes (ctype)
+  "Get the CDR of the record which is either a PLIST of attributes or NIL if CTYPE record doesn't exist."
+  (cdr (assoc ctype *ctype-registry*)))
+
+(defun ctype-indexable-p (ctype)
+  "Return T if CTYPE is indexable."
+  (getf (get-ctype-attributes ctype) :indexable))
+
+(defun set-ctype-indexable (ctype indexable-p)
+  "Set the value of CTYPE's :INDEXABLE attribute to INDEXABLE-P. INDEXABLE-P is either T or NIL."
+  (let ((ctype-register (get-ctype-attributes ctype)))
+    (setf (getf ctype-register :indexable) indexable-p)))
+
+(defun indexable-ctypes ()
+  "Loop over *CTYPE-REGISTRY* and return a LIST of INDEXABLE CTYPES. Used to gather content for index generation."
+  (loop for ctype in *ctype-registry*
+        when (ctype-indexable-p (car ctype))
+          collect (car ctype)))
+
+(defun register-ctype-superclass (ctype superclass)
+  "Register the SUPERCLASS as a direct superclass of the content type CTYPE."
+  (ensure-ctype-record ctype)
+  (let ((ctype-register (get-ctype-attributes ctype)))
+    (or (member superclass (getf ctype-register :superclasses))
+        (setf (getf ctype-register :superclasses)
+              (append (getf ctype-register :superclasses)
+                      (list superclass))))))
+
+(defun register-superclass-to-ctypes (superclass &rest ctypes)
+  "Register the SUPERCLASS to all specified CTYPES."
+  (mapcar #'(lambda (ctype)
+              (register-ctype-superclass ctype superclass))
+          ctypes))
+
+(defun ensure-ctype (ctype)
+  "Ensure CTYPE class exists. Define the class if it is undefined. Update the list of direct superclasses of CTYPE class according to the corresponding CTYPE record in *CTYPE-REGISTRY*."
+  (let* ((superclasses (cons 'content
+                             (getf (get-ctype-attributes ctype)
+                                   :superclasses))))
+    (closer-mop:ensure-class ctype
+                             :direct-superclasses
+                             superclasses)))
+
+(defun ensure-ctypes (ctypes)
+  "Apply ENSURE-CTYPE to all specified CTYPES."
+  (mapcar #'ensure-ctype ctypes))
+
+(defmacro defcontent (name indexable-p &rest body)
+  "Define a CTYPE class sequentially subclassing the list of superclasses defined in CTYPE record in *CTYPE-REGISTRY*. Define if the content type will be indexable or not."
+  (let* ((ctype-register (get-ctype-attributes name))
+         (superclasses (getf ctype-register :superclasses)))
+    `(progn (or (ensure-ctype-record ',name :indexable ,indexable-p)
+                (set-ctype-indexable ',name ,indexable-p))
+            (defclass ,name ,(append '(content) superclasses) ,@body))))
+
+(defmacro defmodifier (name
+                       ctypes
+                       direct-superclasses
+                       direct-slots
+                       &rest options)
+  "Define a CTYPE MODIFIER. A MODIFIER class modifies and extends the behaviour of a content class by directly superclassing it. Its definition is exactly like a class definition except the list of CTYPEs that are going to be effected by the MODIFIER."
+  `(progn (defclass ,name ,direct-superclasses
+            ,direct-slots
+            ,@options)
+          (apply #'register-superclass-to-ctypes '(,name ,@ctypes))
+          (ensure-ctypes '(,@ctypes))))
+
 ;; Tagging
 
 (defclass tag ()

src/documents.lisp

@@ -77,3 +77,7 @@ use it as the template passing any RENDER-ARGS."
   "Remove all instances of DOC-TYPE from memory."
   (dolist (obj (find-all doc-type))
     (remhash (page-url obj) *site*)))
+
+(defun gather-content (doc-types)
+  "Apply FIND-ALL to multiple doc-types so multiple CTYPES can be indexed."
+  (apply #'append (mapcar #'find-all doc-types)))

src/indexes.lisp

@@ -28,7 +28,7 @@
 (defclass tag-index (index) ())
 
 (defmethod discover ((doc-type (eql (find-class 'tag-index))))
-  (let ((content (by-date (find-all 'post))))
+  (let ((content (by-date (gather-content (indexable-ctypes)))))
     (dolist (tag *all-tags*)
       (add-document (index-by-tag tag content)))))
 
@@ -47,7 +47,7 @@
 (defclass month-index (index) ())
 
 (defmethod discover ((doc-type (eql (find-class 'month-index))))
-  (let ((content (by-date (find-all 'post))))
+  (let ((content (by-date (gather-content (indexable-ctypes)))))
     (dolist (month *all-months*)
       (add-document (index-by-month month content)))))
 
@@ -66,7 +66,7 @@
 (defclass numeric-index (index) ())
 
 (defmethod discover ((doc-type (eql (find-class 'numeric-index))))
-  (let ((content (by-date (find-all 'post))))
+  (let ((content (by-date (gather-content (indexable-ctypes)))))
     (dotimes (i (ceiling (length content) 10))
       (add-document (index-by-n i content)))))
 
@@ -93,11 +93,11 @@ of content loaded in the DB."
 (defun all-months ()
   "Retrieve a list of all months with published content."
   (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
-                        (find-all 'post))))
+                        (gather-content (indexable-ctypes)))))
     (sort (remove-duplicates months :test #'string=) #'string>)))
 
 (defun all-tags ()
   "Retrieve a list of all tags used in content."
-  (let* ((dupes (mappend #'content-tags (find-all 'post)))
+  (let* ((dupes (mappend #'content-tags (gather-content (indexable-ctypes))))
          (tags (remove-duplicates dupes :test #'tag-slug=)))
     (sort tags #'string< :key #'tag-name)))

src/packages.lisp

@@ -17,12 +17,26 @@
            #:content
            #:post
            #:index
+           ;; Ctype Registry
+           #:*ctype-registry*
+           #:ensure-ctype-record
+           #:get-ctype-attributes
+           #:ctype-indexable-p
+           #:set-ctype-indexable
+           #:indexable-ctypes
+           #:register-ctype-superclass
+           #:register-superclass-to-ctypes
+           #:ensure-ctype
+           #:ensure-ctypes
+           #:defcontent
+           #:defmodifier
            ;; Content Helpers
            #:title-of
            #:author-of
            #:find-content-by-path
            ;; Theming + Plugin API
            #:theme-fn
+           #:ensure-plugin
            #:plugin-conf-error
            #:render-text
            #:add-injection