blog.el - 0.1 - WordPress client for Emacs

[Ashish Shukla आशीष श ुक्ल]

Hi all,

I'm a new Emacs LISP programmer, and  I've created a blog client similar
to weblogger-mode, but it allows one to type posts in muse-mode. The
client is still in primitive stage but at least it allows one to post to
web-log. It requires muse-mode{,-html}.el and xml-rpc.el Emacs LISP
libraries to be present somewhere in load-path.

To use it, follow the instructions below:

* Copy blog.el and metaweblog.el to some location present in load-path.
* Now load them:

   (require 'blog)

* And, now login to your blog by invoking 'M-x blog-login RET'
  command. This will ask following information:

  Weblog XML-RPC URL ? http://wahjava.wordpress.com/xmlrpc.php
  Weblog User ID ? wahjava
  Weblog ID ? wahjava.wordpress.com
  Weblog Password ? secret

  Please substitute wajava.wordpress.com, wahjava, and secret with your
  blog URL, blog user, and password respectively. During this login
  process, the list of categories will get downloaded.

* Now to start new post, execute 'M-x blog-new-entry RET' . This will
  bring a new *blog* buffer, where you can type your post in Muse syntax
  below the line "--[post] Type your post below this line [post]--". The
  title of the post and list of the categories needs to be filled in
  'Subject' and 'Categories' fields respectively. The 'Categories' field
  supports completion with TAB key.

* To publish your post, press C-c C-c and to save your post press C-c
  C-d . To cancel the simply kill the buffer.

* To clear blog information from the memory, invoke 'M-x blog-logout
  RET' command.

There is a customization group named 'blog' is also provided for you to
customize blog.el settings.

The code might look childish in nature so please point out any silly
mistakes or bugs in the code. Any improvements, coding conventions are
welcome too.

Thanks in advance for your feedback.

Happy blogging :)
Ashish Shukla

- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=blog.el
Content-Transfer-Encoding: quoted-printable
Content-Description: blog.el

;; blog.el -- a wordpress posting client
;; Copyright (C) 2008 Ashish Shukla

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-130=
1, USA.

(require 'muse-mode)
(require 'muse-html)
(require 'metaweblog)

(defgroup blog nil "Post to weblogs from Emacs" :group 'emacs)

(defcustom blog-server-url nil "Weblog XML-RPC URL" :group 'blog :type 'str=
ing)
(defcustom blog-server-user nil "Weblog server username" :group 'blog :type=
 'string)
(defcustom blog-server-pass nil "Weblog server password. If this is
nil you'll be prompted." :group 'blog :type 'string)=20
(defcustom blog-server-weblog-id nil "Weblog ID" :group 'blog :type 'string)
(defcustom blog-default-categories '("Uncategorized") "Default list of cate=
gories" :group 'blog :type '(repeat string))
(defcustom blog-default-title "Hello, World" "Title of the new post" :group=
 'blog :type 'string)

(defvar blog-categories-list nil "List of weblog categories")
(defvar blog-server-xmlrpc-url nil "Weblog server XML-RPC URL")
(defvar blog-server-userid nil "Weblog server user id")
(defvar blog-server-blogid nil "Weblog ID")
(defvar blog-entry-mode-map nil "Keymap for blog entry buffer")
(defvar blog-logged-in nil "Flag whether user is logged-in or not")
(defvar blog-buffer-name "*blog*" "Name of the blog buffer")
(defconst blog-version "0.1" "Current version of blog.el")

(unless blog-entry-mode-map
  (setq blog-entry-mode-map
        (let ((blog-map (make-sparse-keymap)))
          (set-keymap-parent blog-map muse-mode-map)
          (define-key blog-map (kbd "C-c C-c") (lambda() (interactive) 
(blog-post-=
entry t)))
          (define-key blog-map "\t"   'blog-complete-category)
          (define-key blog-map (kbd "<tab>")   'blog-complete-category)
          (define-key blog-map (kbd "C-c C-s") 'blog-post-entry)
          blog-map)))

(defun blog-login()
  "Logs into the blog. Initializes the internal data structures."
  (interactive)
  (setq blog-server-xmlrpc-url (or blog-server-url
                                   (read-no-blanks-input "Weblog XML-RPC URL ? 
")))
  (setq blog-server-userid (or blog-server-user
                               (read-no-blanks-input "Weblog User ID ? ")))
  (setq blog-server-blogid (or blog-server-weblog-id
                               (read-no-blanks-input "Weblog ID ? ")))
  (setq blog-categories-list
        (mapcar (lambda (category) (cdr (assoc "categoryName" category)))
                (metaweblog-get-categories blog-server-xmlrpc-url
                                           blog-server-userid
                                           (or blog-server-pass
                                               (read-passwd "Weblog Password ? 
"))
                                           blog-server-weblog-id)))
  (setq blog-logged-in t))

(defun blog-logout()
  "Logs out from the blog and clears. Clears the internal data structures."
  (interactive)
  (setq blog-server-xmlrpc-url nil
        blog-server-userid nil
        blog-server-blogid nil
        blog-categories-list nil
        blog-logged-in nil))

(defun blog-new-entry()
  "Creates a new blog entry"
  (interactive)
  (unless blog-logged-in
    (error "Please log-in to the blog first"))
  (let ((blog-buffer (generate-new-buffer blog-buffer-name)))
    (switch-to-buffer blog-buffer)
    (muse-mode)
    (mapc
     (lambda (header)
       (let ((p1 (point))
             (p2 0))
         (insert (format "**%s**: %s"
                         (car header)
                         (if (stringp (cdr header))
                             (cdr header)
                           (let* (cats not-first-element)
                             (dolist (val (cdr header) cats)
                               (setq cats
                                     (concat
                                      val
                                      (if not-first-element
                                        ", " (progn (setq not-first-element t) 
""))
                                      cats))))))) (newline)))
     `(("Date" . ,(format-time-string "%Y-%m-%dT%T%z" (current-time)))
       ("Subject" . ,(or blog-default-title ""))
       ("Categories" .  ,blog-default-categories)))
    (newline)
    (insert "--[post] Type your post below this line [post]--")
    (newline)

    (use-local-map blog-entry-mode-map)))

(defun blog-post-entry(&optional publish)
  "Posts blog entry to the blog. If PUBLISH is not-nil, then publishes entr=
y"
  (interactive)
  (unless blog-logged-in (error "Please log-in to the blog first"))
  (let* (r1 r2 html-text list-headers)
    (save-excursion
      (setq list-headers '())
      (goto-char (point-min))
      (dolist (item '("Date" "Subject" "Categories"))
        (when (looking-at (concat "**" item))
          (add-to-list 'list-headers (cons item 
(buffer-substring-no-properties=20
                                                (search-forward ": ")
                                                (point-at-eol))))
          (forward-line)))
      (setcdr (assoc "Categories" list-headers)
              (split-string (cdr (assoc "Categories" list-headers)) ", " t))
      (search-forward "--[post] Type your post below this line [post]--")
      (forward-line)
      (setq r1 (point))
      (setq r2 (point-max))
      (end-of-line)
      (muse-publish-region r1 r2 (cdr (assoc "Subject" list-headers)) (muse=
- -style "xhtml"))
      (search-forward "<!-- Page published by Emacs Muse begins here -->")
      (forward-line)
      (setq r1 (point))
      (search-forward "<!-- Page published by Emacs Muse ends here -->")
      (forward-line -1)
      (end-of-line)
      (setq r2 (point))
      (setq html-text (buffer-substring-no-properties r1 r2))
      (kill-buffer))
      (goto-char (point-max))
      (metaweblog-new-post blog-server-xmlrpc-url
                           blog-server-userid
                           (or blog-server-pass
                               (read-passwd "Weblog Password ? "))
                           blog-server-blogid
                           `(("description" . ,html-text)
                             ("title" . ,(cdr (assoc "Subject" list-headers)))
                             ("categories" . ,(cdr (assoc "Categories" 
list-headers))))
                           publish)
      (kill-buffer)))

(defun blog-complete-category()
  (interactive)
  (let* (current-pos)
    (setq current-pos (point))
    (forward-line 0)
    (if (looking-at "**Categories")
        (progn
          (goto-char current-pos)
          (let ((word-match (or (current-word t) ""))
                (completion-match nil))
            (when word-match
              (setq completion-match (completing-read "Category ? " 
blog-categorie=
s-list nil nil word-match))
              (when (stringp completion-match)
                (search-backward word-match nil t)
              (replace-match (concat completion-match ", ") nil t)))))
      (progn
        (goto-char current-pos)
        (command-execute (lookup-key muse-mode-map "\t"))))))

(provide 'blog)
- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=metaweblog.el
Content-Transfer-Encoding: quoted-printable
Content-Description: metaweblog.el

;; metaweblog.el -- an emacs library to access metaweblog based weblogs
;; Copyright (C) 2008 Ashish Shukla

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-130=
1, USA.

(require 'xml-rpc)

(defun metaweblog-get-categories(blog-xmlrpc user-name password blog-id)
  "Retrieves list of categories from the weblog system"
  (xml-rpc-method-call blog-xmlrpc
                       "metaWeblog.getCategories"
                       blog-id
                       user-name
                       password))

(defun metaweblog-new-post(blog-xmlrpc user-name password blog-id content p=
ublish)
  "Sends a new post to the blog. If PUBLISH is non-nil, the post is
published, otherwise it is saved as draft. CONTENT will be an alist
title, description, categories, and date as keys (string-ified) mapped to t=
he
title of the post, post contents, list of categories, and date respectively=
."=20
  (let ((post-title (cdr (assoc "title" content)))
        (post-description (cdr (assoc "description" content)))
        (post-categories (cdr (assoc "categories" content)))
        (post-date (cdr (assoc "date" content))))
  ;;; since xml-rpc-method-call entitifies the HTML text in the post
  ;;; we've to use raw
  (xml-rpc-xml-to-response (xml-rpc-request
   blog-xmlrpc
   `((methodCall
      nil
      (methodName nil "metaWeblog.newPost")=20
      (params nil=20
              (param nil (value nil (string nil ,blog-id)))
              (param nil (value nil (string nil ,user-name)))
              (param nil (value nil (string nil ,password)))
              (param nil (value nil
                                (struct
                                 nil
                                 (member nil
                                         (name nil "title")
                                         (value nil ,post-title))
                                 (member nil
                                         (name nil "description")
                                         (value nil ,post-description))
                                 (member nil
                                         (name nil "dateCreated")
                                         (value nil ,post-date))
                                 ,(when post-categories
                                    `(member nil=20
                                             (name nil "categories")
                                             (value nil
                                                    (array
                                                     nil
                                                     ,(append=20
                                                       '(data nil)
                                                       (mapcar
                                                        (lambda(f)
                                                          `(value nil (string 
nil ,f)))
                                                        post-categories)))))))))
              (param nil (value nil (boolean nil ,(if publish "1" "0")))))))))))

(defun metaweblog-get-post(blog-xmlrpc user-name password post-id)
  "Retrieves a post from the weblog. POST-ID is the id of the post
which is to be returned"
  (xml-rpc-method-call blog-xmlrpc
                       "metaWeblog.getPost"
                       post-id
                       user-name
                       password))

(defun metaweblog-get-recent-posts(blog-xmlrpc blog-id user-name password n=
umber-of-posts)
  "Fetches the recent posts from the weblog. NUMBER-OF-POSTS is the
no. of posts that should be returned."
  (xml-rpc-method-call blog-xmlrpc
                       "metaWeblog.getRecentPosts"
                       blog-id
                       user-name
                       password
                       number-of-posts))

(provide 'metaweblog)
- --=-=-=--
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.9 (GNU/Linux)

iEYEARECAAYFAkkYR6UACgkQHy+EEHYuXnSAIwCghvDDDt6gIKvQHFqmKHkPCgZn
giAAoKcGYzpoA7qzbCzvEyGEhNXAKfqa
=GAcp
-----END PGP SIGNATURE-----