diff options
Diffstat (limited to 'elisp/erbot/erbrss.el')
| -rw-r--r-- | elisp/erbot/erbrss.el | 375 |
1 files changed, 375 insertions, 0 deletions
diff --git a/elisp/erbot/erbrss.el b/elisp/erbot/erbrss.el new file mode 100644 index 0000000..5604026 --- /dev/null +++ b/elisp/erbot/erbrss.el @@ -0,0 +1,375 @@ +;;; erbrss.el --- Provide an RSS feed from your erbot. +;; Time-stamp: <2005-01-01 17:30:49 forcer> +;; Copyright (C) 2004 Jorgen Schaefer +;; Emacs Lisp Archive entry +;; Filename: erbrss.el +;; Package: erbrss +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +;;; Commentary: + +;; This extension to erbot will provide an RSS feed for your database +;; changes. Customize the erbrss group and run (erbrss-install) to +;; use. + +;;; Code: + +(defgroup erbrss nil + "RSS feeds for the erbot." + :group 'erbot) + +(defcustom erbrss-file-name "/tmp/erbot.rss" + "The file name for the RSS feed. This should be in your web +directory." + :type 'file + :group 'erbrss) + +(defcustom erbrss-rc-file-name "/tmp/erbot-rc.txt" + "The file name to store recent changes info in." + :type 'file + :group 'erbrss) + +(defcustom erbrss-max-age 604800 ; 7 days + "The number of seconds an entry in the recent changes should +stay." + :type 'integer + :group 'erbrss) + +(defcustom erbrss-item-resource-prefix "prefix://" + "The prefix for your item resources. This should be somewhere +on your webserver." + :type 'string + :group 'erbrss) + +(defcustom erbrss-rdf:about "rss about" + "The contents of the rdf:about attribute in your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-title "title" + "The title of your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-link "link" + "The link to your bots homepage, or the RSS feed, or wherever." + :type 'string + :group 'erbrss) + +(defcustom erbrss-description "description" + "The description of your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:rights "rights" + "The copyright notice for your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:publisher "publisher" + "The publisher of your RSS feed, i.e. you." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:contributor "contributor" + "The contributors to your RSS feed. The users of the bot." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image "image" + "A link to an image for your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image-title "image title" + "A title for your RSS feed image." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image-link "image link" + "A link for your image. This should point to your bots home page or so." + :type 'string + :group 'erbrss) + + + +;;; The erbot interface + +(defun erbrss-install () + "Initializer the RSS module of erbot." + (add-hook 'erbot-notify-add-functions 'erbrss-add) + (add-hook 'erbot-notify-forget-functions 'erbrss-forget) + (add-hook 'erbot-notify-move-functions 'erbrss-move) + (add-hook 'erbot-notify-rearrange-functions 'erbrss-rearrange) + (add-hook 'erbot-notify-substitute-functions 'erbrss-substitute) + (add-hook 'erbot-notify-merge-functions 'erbrss-merge)) + +(defun erbrss-add (nick channel term entry-num entry) + "Note an addition to the erbot database. +This is suitable for `erbot-notify-add-functions'." + (erbrss-rc-add term + (format "Added entry %i of %s: %s" entry-num term entry) + (format "%s in %s" nick channel))) + +(defun erbrss-forget (nick channel term entry-num entry remaining-entries) + "Note a removal from the erbot database. +This is suitable for `erbot-notify-forget-functions'." + (erbrss-rc-add term + (if (not (eq entry-num 'all)) + (format "Forgot entry %i of %s: %s\n\nRemaining:\n%s" + entry-num + term + entry + (mapconcat #'identity remaining-entries "\n")) + (format "Forgot %s:\n\n%s" + term + (mapconcat #'identity entry "\n"))) + (format "%s in %s" nick channel))) + +(defun erbrss-move (nick channel old-term new-term) + "Note a move within the erbot database. +This is suitable for `erbot-notify-move-functions'." + (erbrss-rc-add old-term + (format "Moved %s to %s" old-term new-term) + (format "%s in %s" nick channel))) + +(defun erbrss-rearrange (nick channel term + from-num from-entry + to-num to-entry) + "Note a rearrangement in the erbot database. +This is suitable for `erbot-notify-rearrange-functions'." + (erbrss-rc-add term + (format "Swapped entries %i and %i in term %s. Now:\n%i: %s\n%i: %s" + from-num to-num term + to-num from-entry + from-num to-entry) + (format "%s in %s" nick channel))) + +(defun erbrss-substitute (nick channel term entry-num old-entry new-entry) + "Note a substitution in the erbot database. +This is suitable for `erbot-notify-substitue-functions'." + (erbrss-rc-add term + (format "Changed entry %i of %s:\nOld: %s\nNew: %s" + entry-num term old-entry new-entry) + (format "%s in %s" nick channel))) + +(defun erbrss-merge (nick channel from-term to-term + from-entries to-entries final-entries) + "Note a merge in the erbot database. +This is suitable for `erbot-notify-merge-functions'." + (erbrss-rc-add + term + (format (concat "Merged %s into %s. New contents:\n" + "(1 means from %s, 2 from %s and + from both)\n" + "%s") + old-term new-term + old-term new-term + (erbrss-merge-description from-entries + to-entries + final-entries)) + (format "%s in %s" nick channel))) + +(defun erbrss-merge-description (from-entries to-entries final-entries) + "Return a string describing the merge. The string contains a +line per entry in FINAL-ENTRIES, prefixed with a 1 if that +entry is from FROM-ENTRIES, 2 if it is from TO-ENTRIES, and + +if it is from both." + (mapconcat (lambda (entry) + (format "%s %s" + (let ((fromp (member entry from-entries)) + (top (member entry to-entries))) + (cond + ((and fromp top) "+") + (fromp "1") + (top "2") + (t "?"))) + entry)) + final-entries + "\n")) + + +;;; Recent Changes +(defun erbrss-rc-add (term description contributor) + "Add this item to the recent changes list. +The list is managed in `erbrss-rc-file-name'." + (with-current-buffer (find-file-noselect erbrss-rc-file-name t) + (goto-char (point-min)) + (when (= (point-min) (point-max)) + (insert "()")) + (let* ((olddata (read (current-buffer))) + (newdata (erbrss-rc-remove-old + (append olddata + (list + (erbrss-make-item term + description + (current-time) + contributor)))))) + (delete-region (point-min) (point-max)) + (prin1 newdata (current-buffer)) + (let ((require-final-newline t)) + (save-buffer)) + (erbrss-regenerate-rss newdata)))) + +(defun erbrss-rc-remove-old (items) + "Remove any items from ITEMS that are older then `erbrss-max-age'." + (let ((new '())) + (while items + (when (< (- (float-time) + (float-time (erbrss-item-time (car items)))) + erbrss-max-age) + (setq new (cons (car items) + new))) + (setq items (cdr items))) + (reverse new))) + + +;;; RSS +(defun erbrss-regenerate-rss (items) + "Regenerate the RSS feed from ITEMS. +The feed is put into `erbrss-file-name'." + (with-current-buffer (find-file-noselect erbrss-file-name t) + (delete-region (point-min) (point-max)) + (erbrss-insert-rss items) + (let ((require-final-newline t)) + (save-buffer)))) + +(defun erbrss-insert-rss (items) + "Insert an RSS feed with ITEMS in it. +ITEMS should be a list of vectors, each vector having four elements: + +- Title +- Description +- Contributor +- Timestamp in seconds since the epoch" + (erbrss-sxml-insert + `((rdf:RDF (@ (xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#") + (xmlns "http://purl.org/rss/1.0/") + (xmlns:dc "http://purl.org/dc/elements/1.1/")) + (channel (@ (rdf:about ,erbrss-rdf:about)) + (title ,erbrss-title) + (link ,erbrss-link) + (description ,erbrss-description) + (dc:rights ,erbrss-dc:rights) + (dc:date ,(erbrss-date)) + (dc:publisher ,erbrss-dc:publisher) + (dc:contributor ,erbrss-dc:contributor) + (items + (rdf:Seq + ,@(mapcar (lambda (item) + `(rdf:li (@ (rdf:resource + ,(erbrss-item-resource item))))) + items))) + (image (@ (rdf:resource ,erbrss-image)))) + + (image (@ (rdf:resource ,erbrss-image)) + (title ,erbrss-image-title) + (url ,erbrss-image) + (link ,erbrss-image-link)) + + ,@(mapcar #'erbrss-item items))))) + +(defun erbrss-item (item) + "Insert the RSS description of ITEM." + `(item (@ (rdf:about ,(erbrss-item-resource item))) + (title ,(erbrss-item-title item)) + ;(link ,(erbrss-item-resource item)) + (description ,(erbrss-item-description item)) + (dc:date ,(erbrss-date (erbrss-item-time item))) + (dc:contributor ,(erbrss-item-contributor item)))) + +(defun erbrss-make-item (title description time contributor) + "Create a new rss item entry." + (vector title description time contributor)) + +(defun erbrss-item-title (item) + "Return the title of ITEM." + (aref item 0)) + +(defun erbrss-item-description (item) + "Return the description of ITEM." + (aref item 1)) + +(defun erbrss-item-time (item) + "Return the modification time of ITEM." + (aref item 2)) + +(defun erbrss-item-contributor (item) + "Return the contributor of ITEM." + (aref item 3)) + +(defun erbrss-item-resource (item) + "Return the resource of ITEM. +This uses `erbrss-item-resource-prefix'." + (concat erbrss-item-resource-prefix + (erbrss-item-title item) + "?" (erbrss-date (erbrss-item-time item)))) + +(defun erbrss-date (&optional time) + "Return a string describing TIME, or the current time if nil." + (format-time-string "%Y-%m-%dT%H:%M:%S+00:00" + (or time + (current-time)) + t)) + + +;;; SXML + +(defun erbrss-sxml-insert (data) + "Insert an SXML data structure DATA." + (set-buffer-file-coding-system 'utf-8) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n") + (erbrss-sxml-insert-data data)) + +(defun erbrss-sxml-insert-data (data) + "Insert a list of tags DATA as SXML." + (cond + ((stringp data) + (insert (erbrss-sxml-quote data))) + ((symbolp (car data)) + (erbrss-sxml-insert-tag data)) + (t + (mapcar #'erbrss-sxml-insert-data data)))) + +(defun erbrss-sxml-insert-tag (tag) + (let ((name (symbol-name (car tag))) + (attributes (if (and (consp (cdr tag)) + (consp (cadr tag)) + (eq '@ (caadr tag))) + (cdadr tag) + '())) + (body (if (and (consp (cdr tag)) + (consp (cadr tag)) + (eq '@ (caadr tag))) + (cddr tag) + (cdr tag)))) + (insert "<" name) + (mapcar (lambda (entry) + (insert " " + (erbrss-sxml-quote (symbol-name (car entry))) + "=\"" + (erbrss-sxml-quote (cadr entry)) + "\"")) + attributes) + (if (null body) + (insert "/>") + (insert ">") + (mapcar #'erbrss-sxml-insert-data body) + (insert "</" + (erbrss-sxml-quote name) + "\n>")))) + +(defun erbrss-sxml-quote (string) + "Quote <, > and & in STRING." + (with-temp-buffer + (mapcar (lambda (char) + (cond + ((char-equal char ?&) (insert "&")) + ((char-equal char ?<) (insert "<")) + ((char-equal char ?>) (insert ">")) + (t (insert char)))) + string) + (buffer-substring (point-min) (point-max)))) + +(provide 'erbrss) +;;; erbrss.el ends here |