From mt-el@marginalia.org  Wed Oct  2 05:36:48 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Tue, 01 Oct 2002 21:36:48 -0700
Subject: [mt-el] Released...
Message-ID: <87it0lpicf.fsf@telus.net>

Hello all,

Just letting you know that I'm going to release the code wide after
sending this message. Word of its location is out, and I'm reasonably
happy with how its functioning right now, so...

The code being released is unchanged from the latest release.

Bill
-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org


From mt-el@marginalia.org  Wed Oct  9 02:45:41 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Tue, 08 Oct 2002 18:45:41 -0700
Subject: [mt-el] new version of movable type
Message-ID: <87elb0o056.fsf@telus.net>

Hello all,

As you're all probably aware, a new version of movable type is
out. Perusing the changelog
( http://www.movabletype.org/docs/mtchanges.html#2.5%20(2002.10.08) ),
it looks like there is some new functionality available in the
metaWeblogAPI, specifically some new fields in newPost/editPost:

mt_allow_comments, mt_allow_pings, mt_convert_breaks, mt_text_more,
and mt_excerpt.

I'll be looking into this over the next day or so and will hopefully
have something in place to use the new features. 

Off the top of my head, I'll likely make allow_comments, allow_pings
and convert_breaks customization items, and text_more and excerpt
something you can mark in a post buffer.

If you have any bright ideas about how things should work, now's the
time to speak up. :-)

Cheers,
Bill
-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org


From mt-el@marginalia.org  Mon Oct 21 01:46:50 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Sun, 20 Oct 2002 17:46:50 -0700
Subject: [mt-el] beta code!
Message-ID: <87elakr539.fsf@telus.net>

--=-=-=

How exciting!

There's a new version of mt.el attached to this message. 

Most of the new functionality has to do with incorporating some of the
new features added to the XML-RPC API in MT 2.5. You can now use mt.el
to edit extended entries and excerpts. You can also set if trackbacks
and comments are allowed on posts.

Customize the weblog group to get a sense of how the new features
work. I haven't added any new keyboard shortcuts at this point, as I'm
not sure what shortcuts are generally needed. Do people often want to
toggle trackback/comments on a post? As is, you can configure either
yes/no/ask for any of the new features.

The only change to prior functionality is that weblog-auto-categories
now does something; you can set it to yes/no/ask. Yes means the set
category buffer is always created for a new post, ask means you're
prompted and no, unsuprisingly, means no.

Also, when this code is widely released I'll no longer be hosting
xml-rpc.el, as the new version is now hosted at
http://elisp.info/package/xml-rpc/xml-rpc.el. I recommend installing
the version from there, it's got speed improvements that are pretty
impressive, especially in emacs.

As always, have the appropriate amount of fun.

-b


--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=mt.el
Content-Transfer-Encoding: 8bit

;; mt.el - Elisp package for posting to an MT blog via XML-RPC
;; $Id: mt.el,v 1.21 2002/10/20 23:28:41 was Exp $

;; Copyright (C) 2002 Bill Stilwell

;; Author: Bill Stilwell <bill@marginalia.org>
;; Version: 0.99
;; Created: August 7 2002
;; 
;; This file is NOT (yet) part of GNU Emacs.

;; This 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, or (at your option)
;; any later version.

;; this software 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; This packages enables you to create new posts and edit old posts on
;; your Movable Type Weblog. It may be expanded so that any weblog
;; tool that supports the metaWeblog API can be used.

;;; THANKS & CREDIT:
;; mt.el is based heavily on the blogger.el package by Mark
;; A. Hershberger (http://mah.everybody.org/hacks/emacs/blogger.el.txt)
;; and Jamie Zawinski's LiveJournal package
;; (http://www.jwz.org/hacks/jwz-lj.el). All the good parts here are
;; probably from them; the parts that screw up are mine.


;;; INSTALLATION:
;;
;; To install, put mt.el somewhere in your load path:
;; e.g.: (add-to-list 'load-path "~/elisp")

;; and add these lines to your .emacs or ~/.xemacs/init.el:
;; (require 'mt)
;; (global-set-key "\C-cwc" 'weblog-create-post)
;; (global-set-key "\C-cwr" 'weblog-retrieve-recent-posts)
;; (global-set-key "\C-cwg" 'weblog-retrieve-post)
;;
;; This will load mt.el and bind C-c w c to the post creation command.
;;
;; You will also need to set a few variables, either in your .emacs or
;; via the customization system.

;; With customize:

;; Type M-x customize-group <RET> weblog <RET>. You will need to set:
;;
;; Id - This is the id of your weblog. You can get this from the query
;; string when you go into the movable type main menu for your
;; weblog. You should have something like:
;; 'mt.cgi?__mode=menu&blog_id=1'. In this example, the Id would be 1.
;;
;; Username - username
;;
;; Password - password
;;
;; Url - complete URL to access the mt xmlrpc service. This is likely
;; to be something like:
;; http://www.example.com/PATH/TO/MT/mt-xmlrpc.cgi
;;
;; You can also set Post Count to something other than the
;; default. This value is used when no count is provided to the
;; retrieve recent posts command.
;;
;; If you wish, you can set these values directly in your .emacs:
;; (setq weblog-id "1")
;; (setq weblog-username "My Username")
;; (setq weblog-password "easy")
;; (setq weblog-url "http://www.example.com/mt/mt-xmlrpc.cgi")
;; (setq weblog-post-count 5)
;; (setq weblog-publish-on-save t)
;;
;;; USING mt.el
;; C-c w c -- create a new buffer for a new post

;; C-c w r -- retrieve a set of recent posts. If a prefix argument is
;;            supplied (e.g. C-u 3 C-c w r), that number of posts will
;;            be fetched; otherwise the value of weblog-post-count is
;;            used. A new buffer will open with a list of posts, hit
;;            return on any of the posts to edit that post.

;; C-c w g -- get a particular post. You will be prompted for the post
;;            id.

;; C-c C-c -- save it! Will publish if weblog-publish-on-save is
;;            true.

;; C-c C-s -- save without publish, regardless of
;;            weblog-publish-on-save setting.

;; C-c C-p -- save and publish, regardless weblog-publish-on-save setting.

;; C-c C-e -- in post list, edit post at point

;; C-c C-r -- refresh current post buffer

;;; Requirements:

;; requires xml-rpc.el 
;; http://www.marginalia.org/code/xml-rpc.el
;; http://elisp.info/package/xml-rpc/xml-rpc.el
;; and xml.el
;; ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el

;; elib is required (http://www.gnu.org/software/elib/elib.html)

;; if you're using emacs, you may need to put (require 'cl) in your
;; .emacs (thanks to Shawn Ledbetter for pointing this out).

;; mt.el uses the metaweblog API (see http://www.xmlrpc.com/metaWeblogApi
;; and movabletype's support for it:
;; http://www.movabletype.org/docs/mtmanual_programmatic.html#xmlrpc%20api.
;;
;; If your weblog does not support these tools, this package will NOT
;; work. To see if your movable type weblog can use XML-RPC, load
;; mt-check.cgi. If you see the following lines, you should be ok:
;;    LWP::UserAgent...
;;        Your server has LWP::UserAgent installed.

;;    SOAP::Lite...
;;        Your server has SOAP::Lite installed.
;; 
;; If not, you will have to install them; see MT's installation manual
;; for instructions.
;;
;; There are currently issues with line breaks. If you set up MT to
;; automatically convert linebreaks and you have auto-fill on in your
;; entry buffer (or fill before submitting), you will end up breaking
;; entries where auto fill wraps tags in the middle. My current
;; recommendation is to turn this off in your MT preferences and have
;; mt.el wrap your paragraphs in <p> tags. However, if you really
;; don't like this, turn off weblog-wrap-paras in customize

;; The publish flag

;; The default behaviour for MT's XML-RPC API is to always set a
;; post's status to Publish. From comments in XMLRPCServer.pm:

;; ## In 2.1 we changed the behavior of the $publish flag. Previously, 
;; ## it was used to determine the post status. That was a bad idea. 
;; ## So now entries added through XML-RPC are always set to publish, 
;; ## unless the user has set "NoPublishMeansDraft 1" in mt.cfg, which 
;; ## enables the old behavior. 

;; So the _default_ behaviour when setting publish to nil (either in
;; your configuration settings or with an explicit
;; weblog-submit-no-publish) is to create or save a post with a status
;; of publish but no site rebuild. If you change the setting in your
;; mt.cfg, the same action will set the status accordingly.

;; TODO 

;; BUGS

;; Paragraph wrapping breaks on the last paragraph if there isn't a
;; newline at the end. Current hack fix is to add newline at the end.

;;; CODE

(require 'xml-rpc)

(defgroup weblog nil
  "Emacs interface to the metaWeblogAPI."
  :group 'emacs)

(defcustom weblog-id nil
  "Id for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-username nil
  "Username for this weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-password nil
  "Password for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-url nil
  "Complete url to your XMLRPC service."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-count 5
  "Default number of posts to retrieve if no count supplied."
  :group 'weblog
  :type 'integer)

(defcustom weblog-publish-on-save t
  "If t, publish on save."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-wrap-paras t
  "If t, mt.el will wrap paragraphs in <p> tags, and you should turn this
  functionality off in MT. If nil, no wrapping will be done, but you
  should turn off auto-fill in your post buffers."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-local-save-dir "~/.mt"
  "Used to cache weblog name and local copies of posts"
  :group 'weblog
  :type 'directory)

(defcustom weblog-auto-categories 0
  "If t, mt will automatically prompt you to set categories on new posts."
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-comments 1
  "Default value for the allow-comments field. Can be Yes, No, or Ask"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-pings 1
  "Default value for the allow-pings field. If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-convert-breaks 0
  "Should MT convert line breaks? If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-post-marker "--post follows this line--\n"
  "String to demarcate title and post."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-post-marker "--end of post--\n"
  "String to mark end of main post body."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-extended 0
  "Add an extended entry section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-extended-marker "--extended entry follows this line--\n"
  "String to mark beginning of extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-extended-marker "--end of extended--\n"
  "String to mark end of an extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-excerpt 0
  "Add an excerpt section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-excerpt-marker "--excerpt follows this line--\n"
  "String to mark beginning of excerpt."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-excerpt-marker "--end of excerpt--\n"
  "String to mark end of excerpt."
  :group 'weblog
  :group 'string)


(defvar mt-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-mode-map))
    (define-key map "\C-c\C-c" 'weblog-submit-post)
    (define-key map "\C-c\C-s" 'weblog-submit-publish)
    (define-key map "\C-c\C-p" 'weblog-submit-no-publish)
    (define-key map "\C-c\C-e" 'weblog-edit-post-at-point)
    (define-key map "\C-c\C-r" 'weblog-refresh-buffer)
    (define-key map "\C-c\C-d" 'mt-cat-create-buffer)
    map))

(defvar mt-cat-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-cat-mode-map))
    (suppress-keymap map)
    (define-key map "p" 'mt-cat-toggle-primary)
    (define-key map "s" 'mt-cat-toggle-secondary)
    (define-key map "\C-c\C-c" 'mt-cat-update)
    map))

(defvar weblog-mode-hook nil
  "Hook run after starting up weblog mode.")

(defvar weblog-new-post-hook nil
  "Hook to run when visiting a new post buffer")

(defun weblog-mode ()
  "Major mode for editing posts for a weblog."
  (interactive)
  (text-mode)
  (use-local-map mt-mode-map)
  (setq mode-name "weblog")
  (setq major-mode 'weblog-mode)
  ;; what would be nice for hooks is to have it prompt for
  ;; title/category or not depending on user preference
  (run-hooks 'weblog-mode-hook))

(defun weblog-cat-mode ()
  "Major mode for editing categories on a post."
  (interactive)
  (text-mode)
  (use-local-map mt-cat-mode-map)
  (setq mode-name "weblog-cat")
  (setq major-mode 'weblog-cat-mode)
  (setq buffer-read-only t))

(defun weblog-create-post ()
  "*Compose a weblog post."
  (interactive)
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Title: \n")
  (insert weblog-begin-post-marker)
  (insert "\n\n")
  (insert weblog-end-post-marker)
  (if (> (weblog-add-extended-p) 0)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker)))
  (if (> (weblog-add-excerpt-p) 0)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker)))
  (beginning-of-buffer)
  (end-of-line)
  (weblog-mode)
  (run-hooks 'weblog-new-post-hook))

(defun weblog-submit-post (&optional publish)
  "*Publish current message."
  (interactive)
  (setq new-post (new-postp))
  (weblog-refresh-buffer
  (if new-post
      (mwa-new-post publish)
    (mwa-edit-post publish)))
  (if new-post
      (if (weblog-auto-categories-p)
	  (mt-cat-create-buffer))))

(defun weblog-retrieve-post (&optional post-id)
  "*Retrieves a post for a given weblog post id."
  (interactive)
  (create-post-buffer 
   (mwa-get-post (or post-id (read-from-minibuffer "Post Id: ")))))

(defun weblog-retrieve-recent-posts (&optional num)
  "*Retrieve a list of recent posts, puts in a buffer for further editing."
  (interactive "P")
  (create-posts-buffer (mwa-get-recent-posts (or num weblog-post-count))))

(defun weblog-edit-post-at-point ()
  "Edit the post at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(create-post-buffer (mwa-get-post (match-string 1)))
      (error "Couldn't determine post number"))))

(defun weblog-submit-publish ()
  "Save and publish post regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '1))

(defun weblog-submit-no-publish ()
  "Save without publish regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '0))

(defun weblog-switch-weblog (&optional id)
  "Convenient way to switch what weblog is posted to"
  (interactive)
  (setq weblog-id (or id (read-from-minibuffer "Blog Id: ")))
  (setq weblog-name (mt-get-weblog-name weblog-id)))

(defun weblog-auto-categories-p ()
  "Returns t if a categories buffer should be setup."
  (if (> weblog-auto-categories 1)
      (if (y-or-n-p "Set categories on this post? ")
	  t
	nil)
    (if (= weblog-auto-categories 1)
	t
      nil)))

(defun weblog-allow-comments-p ()
  "Returns t if comments should be allowed for this post."
  (if (> weblog-allow-comments 1)
      (if (y-or-n-p "Allow comments on this post? ")
	  '1
	'0)
    weblog-allow-comments))

(defun weblog-allow-pings-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-allow-pings 1)
      (if (y-or-n-p "Allow pings on this post? ")
	  '1
	'0)
    weblog-allow-pings))

(defun weblog-convert-breaks-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-convert-breaks 1)
      (if (y-or-n-p "Convert line breaks on this post? ")
	  '1
	'0)
    weblog-convert-breaks))

(defun weblog-go-to-body ()
  "Moves point to beginning of post body."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-post-marker))

(defun weblog-go-to-excerpt ()
  "Moves point to beginning of excerpt."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-excerpt-marker))

(defun weblog-go-to-extended ()
  "Moves point to beginning of extended entry."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-extended-marker))

(defun weblog-add-excerpt-p ()
  "Return t if a block for an excerpt should be added to this post."
  (if (> weblog-post-buffer-excerpt 1)
      (if (y-or-n-p "Add an excerpt block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-excerpt))

(defun weblog-add-extended-p ()
  "Return t if a block for an extended entry should be added to this post."
  (if (> weblog-post-buffer-extended 1)
      (if (y-or-n-p "Add an extended entry block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-extended))

(defun create-posts-buffer (posts)
  "Creates a listing of retrieved posts"
  ; Needs to add a key binding for return to edit a post maybe
  (switch-to-buffer (generate-new-buffer "*weblog-posts*"))
  (insert "Recent posts:\n\n")
  (mapcar 
   (lambda (post)
     (setq post-id (cdr (assoc "postid" post)))
     (setq post-title (cdr (assoc "title" post)))
     (setq post-body (cdr (assoc "description" post)))
     (insert post-id)
     (insert " ")
     (insert post-title)
     (insert "\n"))
   posts)
  (weblog-mode)
  (goto-char (point-min)))
	  
(defun create-post-buffer (post)
  "Creates buffer filled with post info"
  ;; so we should have a struct in post
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (setq post-comments-allowed (cdr (assoc "mt_allow_comments" post)))
  (setq post-pings-allowed (cdr (assoc "mt_allow_pings" post)))
  (setq post-convert_breaks (cdr (assoc "mt_convert_breaks" post)))
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name post-id post-comments-allowed post-pings-allowed)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert (mt-clean-body post-body))
  (insert "\n")
  (insert weblog-end-post-marker)
  (if post-extended
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if post-excerpt
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker)))
  (weblog-go-to-body)
  (end-of-line)
  (weblog-mode))

(defun get-post-buffer-name (&optional post-id comments pings)
  (setq log-name (mt-get-weblog-name weblog-id))
  (if comments
      (setq comment-string "Com: Y")
    (if post-id
	(setq comment-string "Com: N")
      (cond 
       ((= weblog-allow-comments 2)
	(setq comment-string "Com: ?"))
       ((= weblog-allow-comments 1)
	(setq comment-string "Com: Y"))
       ((= weblog-allow-comments 0)
	(setq comment-string "Com: N")))))
  (if pings
      (setq ping-string "TB: Y")
    (if post-id
	(setq ping-string "TB: N")
      (cond 
       ((= weblog-allow-pings 2)
	(setq ping-string "TB: ?"))
       ((= weblog-allow-pings 1)
	(setq ping-string "TB: Y"))
       ((= weblog-allow-pings 0)
	(setq ping-string "TB: N")))))
  (if post-id
      (concat "*post " post-id " (" log-name ") " comment-string " " ping-string "*") ; need to check if numberp?
    (concat "*post (" log-name ") " comment-string " " ping-string "*"))) ; stupid 

;; metaweblogapi implementations
(defun mwa-new-post (&optional publish)
  "Makes a new post via metaWeblogAPI newPost command"
  (xml-rpc-method-call 
   weblog-url 
   'metaWeblog.newPost 
   weblog-id 
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-edit-post (&optional publish)
  "Edits a post via metaWeblogAPI editPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.editPost
   (weblog-post-id)
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-get-post (post-id)
  "Gets a single post via metaWeblogAPI getPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getPost
   post-id
   weblog-username
   weblog-password))

(defun mwa-get-recent-posts (number-of-posts)
  "Gets specified number of recent posts via metaWeblogAPI getRecentPosts command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getRecentPosts
   weblog-id
   weblog-username
   weblog-password
   number-of-posts))

;; MovableType XMLRPC implementation - category stuff

(defun mt-get-category-list ()
  "Gets list of categories for a weblog via mt API getCategoryList command"
  (xml-rpc-method-call
   weblog-url
   'mt.getCategoryList
   weblog-id
   weblog-username
   weblog-password))

(defun mt-get-post-categories (&optional post-id)
  "Gets categories for a post via mt API getPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.getPostCategories
   (or post-id (weblog-post-id))
   weblog-username
   weblog-password))

(defun mt-set-post-categories (post-id post-categories)
  "Sets categories for a post via mt API setPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.setPostCategories
   post-id
   weblog-username
   weblog-password
   post-categories))

(defun mt-get-trackback-pings ()
  "Retrieves trackback pings for an entry, if any."
  (xml-rpc-method-call
   weblog-url
   'mt.getTrackbackPings
   (weblog-post-id)))

(defun mt-publish-post (&optional post-id)
  "Rebuild the static files related to an entry."
  (xml-rpc-method-call
   weblog-url
   'mt.publishPost
   (or post-id (weblog-post-id))))

;; blogger api implementation
(defun blogger-get-users-blogs ()
  "Retrieves info about current users blogs"
  (xml-rpc-method-call
   weblog-url
   'blogger.getUsersBlogs
   '""
   weblog-username
   weblog-password))

;; support utility functions
(defun weblog-post-title ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Title:[ \t]*\\(.*\\)$" nil t)
	  (setq post-title (match-string 1))
	(read-from-minibuffer "Post Title: " post-title))
      (xml-rpc-encode post-title))))

(defun weblog-post-body ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-post-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-post-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	nil))))

(defun weblog-post-excerpt ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-excerpt-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-excerpt-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun weblog-post-extended ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-extended-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-extended-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun xml-rpc-encode (string)
  "Replaces < with &lt; and & with &amp;"
  (let (buf)
    (save-excursion
      (unwind-protect
	  (progn
	    (setq buf (get-buffer-create " *xml-rpc-escape*"))
	    (set-buffer buf)
	    (erase-buffer)
	    (insert-string string)
	    
	    ;; This whole section is a massive massive hack
	    (goto-char (point-min))
	    (while (re-search-forward "&" nil t)
	      (replace-match "&amp;" nil nil)) ;; can't have bare &
	    (goto-char (point-min))
	    (while (re-search-forward "<" nil t)
	      (replace-match "&lt;" nil nil))  ;; can't have bare <
	    (buffer-string))
	(if buf (kill-buffer buf))))))

(defun wrap-paragraphs (string)
    (save-excursion
      (unwind-protect
	  (progn
	    (with-temp-buffer
	      (insert-string string)
	      (goto-char (point-min))
	      ;; only try and wrap if there's something non-empty to wrap
	      (if (re-search-forward "[^ \n\t\r]" nil t)
		  (lambda
		    (goto-char (point-max))
		    ;; blecherous hack here
		    (while (mt-looking-back-at "\n")
		      (delete-backward-char 1))
		    (insert "\n")
		    (goto-char (point-min))
		    (while (not (eq (point) (point-max)))
		      (start-of-paragraph-text)
		      (if (not (looking-at "<p>"))  
			  (insert "<p>")) 
		      (end-of-paragraph-text) 
		      (if (not (mt-looking-back-at "</p>"))  
			  (insert "</p>"))
		      (end-of-paragraph-text))))
		    (buffer-string))))))
  

(defun weblog-post-id ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Post Id:[ \t]*\\([0-9]*\\).*$" nil t)
	  (setq post-id (match-string 1))
	(setq post-id nil)))))

(defun weblog-insert-post-contents (post)
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert post-body)
  (insert "\n")
  (insert weblog-end-post-marker)
  (if post-extended
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if post-excerpt
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker))))
  
(defun weblog-refresh-buffer (&optional post-id)
  "Refreshes content of current buffer with whatever mt server has."
  (interactive)
  (setq pm (point-max))
  (goto-char (point-max))
  (if (stringp post-id)
      (setq id post-id)
    (setq id (weblog-post-id)))
  (weblog-insert-post-contents
   (mwa-get-post id))
  (delete-region (point-min) pm)
  (weblog-go-to-body))

(defun new-postp ()
  "Return t if buffer is a new post."
  (not (weblog-post-id)))

(defun publishp ()
  "Return 1 if publish, 0 otherwise."
  (if weblog-publish-on-save
      (setq publish '1)
    (setq publish '0)))

(defun mt-looking-back-at (regexp &optional bound)
  "Return t if text before point matches REGEXP.
Modifies the match data. If supplied, BOUND means not to look farther
back that that many characters before point. Otherwise, it defaults to
\(length REGEXP), which is good enough when REGEXP is a simple
string."
  ;; taken from mmm-mode - mmm-utils.el
  (eq (point)
      (save-excursion
        (and (re-search-backward regexp
               (- (point) (or bound (length regexp)))
               t)
             (match-end 0)))))

(defun mt-clean-body (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward "&#xd;" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-get-weblog-name (&optional log-id)
  "retrieves name of a weblog given an id, either from local file or net"
  (if (mt-weblog-file-exists-p (or log-id weblog-id))
      (mt-read-weblog-name (or log-id weblog-id))
    (mt-store-weblog-name (mt-fetch-weblog-name (or log-id weblog-id)))))

(defun mt-weblog-file-exists-p (log-id)
  "Tests to see if the weblog name file exists"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (file-exists-p weblog-file-name))

(defun mt-read-weblog-name (log-id)
  "Reads the weblog name from a file"
  (with-temp-buffer
    (insert-file-contents (concat weblog-local-save-dir "/" "weblog." log-id))
    (goto-char (point-min))
    (while (re-search-forward "\n" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-store-weblog-name (weblog-name)
  "Stores the weblog name in a file"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (if (not (file-directory-p weblog-local-save-dir))
      (make-directory weblog-local-save-dir))
  (with-temp-buffer
    (insert weblog-name)
    (insert "\n")
    (append-to-file (point-min) (point-max) weblog-file-name))
  weblog-name)

(defun mt-fetch-weblog-name (log-id)
  "Fetches weblog name from server using XML-RPC"
  (setq weblog-name nil)
  (mapc
   (lambda (log-info)
     (if (string= (or log-id weblog-id) (cdr (assoc "blogid" log-info)))
	 (setq weblog-name (cdr (assoc "blogName" log-info)))))
   (blogger-get-users-blogs))
  weblog-name)


;; category handling stuff

;; Here's the basics of what I'd like to do:
;; - have a buffer created (probably split the window) that gives the
;;   categories available
;; - allow user to mark primary and secondary categories. Only one
;;   primary category is allowed, as many secondary as necessary.
;; - an update command that sets the categories on a post.
(require 'cookie)

(defvar mt-cat-col nil)

(defvar mt-cat-buf "*Category Selection*")

(defun mt-cat-create-buffer (&optional post-id)
  "Creates a buffer filled with categories."
  (interactive)
  (setq post-id (or post-id (or (weblog-get-post-id-at-point) (weblog-post-id))))
  (split-window)
  (save-excursion
    (set-buffer (get-buffer-create mt-cat-buf))
    (setq buffer-read-only nil)
    (erase-buffer))
  (setq mt-cat-col (mt-cat-create-cookie-collection post-id))
  (mt-cat-enter-cookies post-id (mt-get-post-categories post-id))
  (other-window 1)
  (switch-to-buffer mt-cat-buf)
  
  (weblog-cat-mode))

(defun weblog-get-post-id-at-point ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(match-string 1))))


(defun mt-cat-create-cookie-collection (post-id)
  (collection-create
   mt-cat-buf
  (function mt-cat-pp)
  (concat "Post " post-id " category selection\n") 
  "\n+ Primary category\n- Secondary category" 0))

(defun mt-cat-enter-cookies (post-id post-categories)
  (collection-append-cookies 
   mt-cat-col
   (mapcar 
    (lambda (category)
      (setq cat-id 
	    (cdr (assoc "categoryId" category)))
      (setq cat-primary 
	    (mt-post-primary post-categories))
      (setq cat-secondary 
	    (mt-post-secondary post-categories))
      (list (cons "cat-id" cat-id)
	    (cons "cat-name" 
		  (cdr (assoc "categoryName" category)))
	    (cons "primary" 
		  (is-primary-p cat-id cat-primary))
	    (cons "secondary" 
		  (is-secondary-p cat-id cat-secondary))))
    (mt-get-category-list))))

(defun is-primary-p (cat-id cat-primary)
  (if (string= cat-id cat-primary)
      t
    nil))

(defun is-secondary-p (cat-id cat-secondary)
  (if (member cat-id cat-secondary)
      t
    nil))

(defun mt-post-primary (post-categories)
  "Returns the category id of the primary category for a post"
  ;; this is a bit hackish and inefficient, as we'll continue looping
  ;; over the list of categories even after we've got our primary
  (let (primary)
    (mapc
     (lambda (category)
       (if (cdr (assoc "isPrimary" category))
	   (setq primary (cdr (assoc "categoryId" category)))))
     post-categories)
    primary))
       
(defun mt-post-secondary (post-categories)
  "Returns a list of the category id(s) of the secondary categories
  for a post"
  (interactive)
  (mapcar
   (lambda (category)
     (if (not (cdr (assoc "isPrimary" category)))
	 (cdr (assoc "categoryId" category))
       nil))
   post-categories))

(defun mt-cat-get-tin (pos)
  (interactive "d")
  (mt-cat-mark-primary cookie))

(defun mt-cat-toggle-primary (pos)
  "toggles primary setting of this category"
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	 (cookie (tin-cookie mt-cat-col tin)))
  (cookie-map
   (function (lambda (cat)
	       ;; if this is our primary cat, toggle it
	       ;; othewise, mark the primary field nil
	       ;; this should enforce only one primary cat at a time,
	       ;; also sets secondary to nil
	       (if (string= (cdr (assoc "cat-id" cookie)) (cdr (assoc "cat-id" cat)))
		   (progn
		     (setcdr (assoc "primary" cat) (mt-cat-toggle (cdr (assoc "primary" cat))))
		     (setcdr (assoc "secondary" cat) nil))
		 (setcdr (assoc "primary" cat) nil))
	       t))
   mt-cat-col)))

(defun mt-cat-toggle-secondary (pos)
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	(cookie (tin-cookie mt-cat-col tin)))

  (setcdr (assoc "secondary" cookie) (mt-cat-toggle (cdr (assoc "secondary" cookie))))
  (setcdr (assoc "primary" cookie) nil)
  (collection-refresh mt-cat-col)
  (goto-char pos))) ; lazy, but why test?


(defun mt-cat-toggle (bool)
  (if bool
      nil
    t))

(defun mt-cat-update ()
  "Sets the category information on the post on the server"
  (interactive)
  (mt-set-post-categories (mt-cat-post-id) (mt-cats-as-array))
  (bury-buffer)
  (delete-window))

(defun mt-cat-post-id ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^Post \\([0-9]*\\).*" nil t)
	(match-string 1))))

(defun mt-cats-as-array ()
  (interactive)
  (mt-cat-get-struct (append (get-primary-cat) (get-secondary-cats))))

(defun mt-cat-get-struct (cats)
  (mapcar 
   (lambda (cat)
     (list (cons "categoryId" (cdr (assoc "cat-id" cat)))))
   cats))
  
(defun get-primary-cat ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-primary-p)))

(defun get-secondary-cats ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-secondary-p)))

(defun is-marked-primary-p (cat)
  (if (cdr (assoc "primary" cat))
      t
    nil))

(defun is-marked-secondary-p (cat)
  (if (cdr (assoc "secondary" cat))
      t
    nil))
  
(defun mt-cat-pp (mt-cat-info)
  "pretty printer for cookie collection"
  (insert "[")
  (cond 
   ((cat-info-primary-p mt-cat-info)
    (insert "+"))
   ((cat-info-secondary-p mt-cat-info)
    (insert "-"))
   (t (insert " ")))
  (insert (concat (cdr (assoc "cat-id" mt-cat-info)) " ]"))
  (insert " ")
  (insert (cdr (assoc "cat-name" mt-cat-info))))

(defun cat-info-primary-p (mt-cat-info)
  (if (cdr (assoc "primary" mt-cat-info))
      t
    nil))

(defun cat-info-secondary-p (mt-cat-info)
  (if (cdr (assoc "secondary" mt-cat-info))
      t
    nil))

(provide 'mt)

;;; mt.el ends here

--=-=-=


-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org

--=-=-=--


From mt-el@marginalia.org  Mon Oct 21 03:36:32 2002
From: mt-el@marginalia.org (Jack Moffitt)
Date: Sun, 20 Oct 2002 20:36:32 -0600
Subject: [mt-el] beta code!
In-Reply-To: <87elakr539.fsf@telus.net>
References: <87elakr539.fsf@telus.net>
Message-ID: <20021021023632.GR10159@i.cantcode.com>

> There's a new version of mt.el attached to this message. 

I just gave this a quick spin.  The new features seem to work great.

I noticed that when saving a new post, I get the following message in
the minibuffer:

Wrong type argument: number-or-marker-p, nil

Also, it seems to add the '--extended entry follows this line--' etc
once I have saved it, even though I don't have those enabled.  Would it
be possible to hide those unless that feature is on?

jack.

From mt-el@marginalia.org  Mon Oct 21 03:59:20 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Sun, 20 Oct 2002 19:59:20 -0700
Subject: [mt-el] beta code!
In-Reply-To: <20021021023632.GR10159@i.cantcode.com> (Jack Moffitt's message
 of "Sun, 20 Oct 2002 20:36:32 -0600")
References: <87elakr539.fsf@telus.net> <20021021023632.GR10159@i.cantcode.com>
Message-ID: <878z0sqyyf.fsf@telus.net>

Jack Moffitt <jack@xiph.org> writes:

>> There's a new version of mt.el attached to this message. 
>
> I just gave this a quick spin.  The new features seem to work great.
>
> I noticed that when saving a new post, I get the following message in
> the minibuffer:
>
> Wrong type argument: number-or-marker-p, nil

Hrm. Could you do a (setq debug-on-error t) and send me the traceback?
What version of emacs?

> Also, it seems to add the '--extended entry follows this line--' etc
> once I have saved it, even though I don't have those enabled.  Would it
> be possible to hide those unless that feature is on?

Hmm, I think my detection routines need a little work. That was
happening to me in xemacs, but I thought I'd fixed it. Back to the
salt mines.

Cheers,
-b
-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org


From mt-el@marginalia.org  Mon Oct 21 04:24:00 2002
From: mt-el@marginalia.org (Jack Moffitt)
Date: Sun, 20 Oct 2002 21:24:00 -0600
Subject: [mt-el] beta code!
In-Reply-To: <878z0sqyyf.fsf@telus.net>
References: <87elakr539.fsf@telus.net> <20021021023632.GR10159@i.cantcode.com> <878z0sqyyf.fsf@telus.net>
Message-ID: <20021021032400.GT10159@i.cantcode.com>

> > Wrong type argument: number-or-marker-p, nil
> 
> Hrm. Could you do a (setq debug-on-error t) and send me the traceback?
> What version of emacs?

Actually this was a leftover problem from when I was experimenting with
weblog-auto-categories, trying to figure out why it didn't work.
Changing 'nil' to '0' fixed it. :)

> > Also, it seems to add the '--extended entry follows this line--' etc
> > once I have saved it, even though I don't have those enabled.  Would it
> > be possible to hide those unless that feature is on?
> 
> Hmm, I think my detection routines need a little work. That was
> happening to me in xemacs, but I thought I'd fixed it. Back to the
> salt mines.

This is still happening even with the above problem fixed, in case that
helps any.  I'm using emacs 21.2.1 which was shipped with RedHat 8.

jack.

From mt-el@marginalia.org  Mon Oct 21 04:40:32 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Sun, 20 Oct 2002 20:40:32 -0700
Subject: [mt-el] beta code!
In-Reply-To: <878z0sqyyf.fsf@telus.net> (Bill Stilwell's message of "Sun, 20
 Oct 2002 19:59:20 -0700")
References: <87elakr539.fsf@telus.net> <20021021023632.GR10159@i.cantcode.com>
 <878z0sqyyf.fsf@telus.net>
Message-ID: <87of9opihb.fsf@telus.net>

--=-=-=

Bill Stilwell <bill@marginalia.org> writes:

> Hmm, I think my detection routines need a little work. That was
> happening to me in xemacs, but I thought I'd fixed it. Back to the
> salt mines.

Think I've got this one licked. Let me know.


--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=mt.el
Content-Transfer-Encoding: 8bit

;; mt.el - Elisp package for posting to an MT blog via XML-RPC
;; $Id: mt.el,v 1.21 2002/10/20 23:28:41 was Exp $

;; Copyright (C) 2002 Bill Stilwell

;; Author: Bill Stilwell <bill@marginalia.org>
;; Version: 0.99
;; Created: August 7 2002
;; 
;; This file is NOT (yet) part of GNU Emacs.

;; This 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, or (at your option)
;; any later version.

;; this software 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; This packages enables you to create new posts and edit old posts on
;; your Movable Type Weblog. It may be expanded so that any weblog
;; tool that supports the metaWeblog API can be used.

;;; THANKS & CREDIT:
;; mt.el is based heavily on the blogger.el package by Mark
;; A. Hershberger (http://mah.everybody.org/hacks/emacs/blogger.el.txt)
;; and Jamie Zawinski's LiveJournal package
;; (http://www.jwz.org/hacks/jwz-lj.el). All the good parts here are
;; probably from them; the parts that screw up are mine.


;;; INSTALLATION:
;;
;; To install, put mt.el somewhere in your load path:
;; e.g.: (add-to-list 'load-path "~/elisp")

;; and add these lines to your .emacs or ~/.xemacs/init.el:
;; (require 'mt)
;; (global-set-key "\C-cwc" 'weblog-create-post)
;; (global-set-key "\C-cwr" 'weblog-retrieve-recent-posts)
;; (global-set-key "\C-cwg" 'weblog-retrieve-post)
;;
;; This will load mt.el and bind C-c w c to the post creation command.
;;
;; You will also need to set a few variables, either in your .emacs or
;; via the customization system.

;; With customize:

;; Type M-x customize-group <RET> weblog <RET>. You will need to set:
;;
;; Id - This is the id of your weblog. You can get this from the query
;; string when you go into the movable type main menu for your
;; weblog. You should have something like:
;; 'mt.cgi?__mode=menu&blog_id=1'. In this example, the Id would be 1.
;;
;; Username - username
;;
;; Password - password
;;
;; Url - complete URL to access the mt xmlrpc service. This is likely
;; to be something like:
;; http://www.example.com/PATH/TO/MT/mt-xmlrpc.cgi
;;
;; You can also set Post Count to something other than the
;; default. This value is used when no count is provided to the
;; retrieve recent posts command.
;;
;; If you wish, you can set these values directly in your .emacs:
;; (setq weblog-id "1")
;; (setq weblog-username "My Username")
;; (setq weblog-password "easy")
;; (setq weblog-url "http://www.example.com/mt/mt-xmlrpc.cgi")
;; (setq weblog-post-count 5)
;; (setq weblog-publish-on-save t)
;;
;;; USING mt.el
;; C-c w c -- create a new buffer for a new post

;; C-c w r -- retrieve a set of recent posts. If a prefix argument is
;;            supplied (e.g. C-u 3 C-c w r), that number of posts will
;;            be fetched; otherwise the value of weblog-post-count is
;;            used. A new buffer will open with a list of posts, hit
;;            return on any of the posts to edit that post.

;; C-c w g -- get a particular post. You will be prompted for the post
;;            id.

;; C-c C-c -- save it! Will publish if weblog-publish-on-save is
;;            true.

;; C-c C-s -- save without publish, regardless of
;;            weblog-publish-on-save setting.

;; C-c C-p -- save and publish, regardless weblog-publish-on-save setting.

;; C-c C-e -- in post list, edit post at point

;; C-c C-r -- refresh current post buffer

;;; Requirements:

;; requires xml-rpc.el 
;; http://www.marginalia.org/code/xml-rpc.el
;; http://elisp.info/package/xml-rpc/xml-rpc.el
;; and xml.el
;; ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el

;; elib is required (http://www.gnu.org/software/elib/elib.html)

;; if you're using emacs, you may need to put (require 'cl) in your
;; .emacs (thanks to Shawn Ledbetter for pointing this out).

;; mt.el uses the metaweblog API (see http://www.xmlrpc.com/metaWeblogApi
;; and movabletype's support for it:
;; http://www.movabletype.org/docs/mtmanual_programmatic.html#xmlrpc%20api.
;;
;; If your weblog does not support these tools, this package will NOT
;; work. To see if your movable type weblog can use XML-RPC, load
;; mt-check.cgi. If you see the following lines, you should be ok:
;;    LWP::UserAgent...
;;        Your server has LWP::UserAgent installed.

;;    SOAP::Lite...
;;        Your server has SOAP::Lite installed.
;; 
;; If not, you will have to install them; see MT's installation manual
;; for instructions.
;;
;; There are currently issues with line breaks. If you set up MT to
;; automatically convert linebreaks and you have auto-fill on in your
;; entry buffer (or fill before submitting), you will end up breaking
;; entries where auto fill wraps tags in the middle. My current
;; recommendation is to turn this off in your MT preferences and have
;; mt.el wrap your paragraphs in <p> tags. However, if you really
;; don't like this, turn off weblog-wrap-paras in customize

;; The publish flag

;; The default behaviour for MT's XML-RPC API is to always set a
;; post's status to Publish. From comments in XMLRPCServer.pm:

;; ## In 2.1 we changed the behavior of the $publish flag. Previously, 
;; ## it was used to determine the post status. That was a bad idea. 
;; ## So now entries added through XML-RPC are always set to publish, 
;; ## unless the user has set "NoPublishMeansDraft 1" in mt.cfg, which 
;; ## enables the old behavior. 

;; So the _default_ behaviour when setting publish to nil (either in
;; your configuration settings or with an explicit
;; weblog-submit-no-publish) is to create or save a post with a status
;; of publish but no site rebuild. If you change the setting in your
;; mt.cfg, the same action will set the status accordingly.

;; TODO 

;; BUGS

;; Paragraph wrapping breaks on the last paragraph if there isn't a
;; newline at the end. Current hack fix is to add newline at the end.

;;; CODE

(require 'xml-rpc)

(defgroup weblog nil
  "Emacs interface to the metaWeblogAPI."
  :group 'emacs)

(defcustom weblog-id nil
  "Id for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-username nil
  "Username for this weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-password nil
  "Password for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-url nil
  "Complete url to your XMLRPC service."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-count 5
  "Default number of posts to retrieve if no count supplied."
  :group 'weblog
  :type 'integer)

(defcustom weblog-publish-on-save t
  "If t, publish on save."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-wrap-paras t
  "If t, mt.el will wrap paragraphs in <p> tags, and you should turn this
  functionality off in MT. If nil, no wrapping will be done, but you
  should turn off auto-fill in your post buffers."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-local-save-dir "~/.mt"
  "Used to cache weblog name and local copies of posts"
  :group 'weblog
  :type 'directory)

(defcustom weblog-auto-categories 0
  "If t, mt will automatically prompt you to set categories on new posts."
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-comments 1
  "Default value for the allow-comments field. Can be Yes, No, or Ask"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-pings 1
  "Default value for the allow-pings field. If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-convert-breaks 0
  "Should MT convert line breaks? If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-post-marker "--post follows this line--\n"
  "String to demarcate title and post."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-post-marker "--end of post--\n"
  "String to mark end of main post body."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-extended 0
  "Add an extended entry section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-extended-marker "--extended entry follows this line--\n"
  "String to mark beginning of extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-extended-marker "--end of extended--\n"
  "String to mark end of an extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-excerpt 0
  "Add an excerpt section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-excerpt-marker "--excerpt follows this line--\n"
  "String to mark beginning of excerpt."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-excerpt-marker "--end of excerpt--\n"
  "String to mark end of excerpt."
  :group 'weblog
  :group 'string)


(defvar mt-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-mode-map))
    (define-key map "\C-c\C-c" 'weblog-submit-post)
    (define-key map "\C-c\C-s" 'weblog-submit-publish)
    (define-key map "\C-c\C-p" 'weblog-submit-no-publish)
    (define-key map "\C-c\C-e" 'weblog-edit-post-at-point)
    (define-key map "\C-c\C-r" 'weblog-refresh-buffer)
    (define-key map "\C-c\C-d" 'mt-cat-create-buffer)
    map))

(defvar mt-cat-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-cat-mode-map))
    (suppress-keymap map)
    (define-key map "p" 'mt-cat-toggle-primary)
    (define-key map "s" 'mt-cat-toggle-secondary)
    (define-key map "\C-c\C-c" 'mt-cat-update)
    map))

(defvar weblog-mode-hook nil
  "Hook run after starting up weblog mode.")

(defvar weblog-new-post-hook nil
  "Hook to run when visiting a new post buffer")

(defun weblog-mode ()
  "Major mode for editing posts for a weblog."
  (interactive)
  (text-mode)
  (use-local-map mt-mode-map)
  (setq mode-name "weblog")
  (setq major-mode 'weblog-mode)
  ;; what would be nice for hooks is to have it prompt for
  ;; title/category or not depending on user preference
  (run-hooks 'weblog-mode-hook))

(defun weblog-cat-mode ()
  "Major mode for editing categories on a post."
  (interactive)
  (text-mode)
  (use-local-map mt-cat-mode-map)
  (setq mode-name "weblog-cat")
  (setq major-mode 'weblog-cat-mode)
  (setq buffer-read-only t))

(defun weblog-create-post ()
  "*Compose a weblog post."
  (interactive)
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Title: \n")
  (insert weblog-begin-post-marker)
  (insert "\n\n")
  (insert weblog-end-post-marker)
  (if (> (weblog-add-extended-p) 0)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker)))
  (if (> (weblog-add-excerpt-p) 0)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker)))
  (beginning-of-buffer)
  (end-of-line)
  (weblog-mode)
  (run-hooks 'weblog-new-post-hook))

(defun weblog-submit-post (&optional publish)
  "*Publish current message."
  (interactive)
  (setq new-post (new-postp))
  (weblog-refresh-buffer
  (if new-post
      (mwa-new-post publish)
    (mwa-edit-post publish)))
  (if new-post
      (if (weblog-auto-categories-p)
	  (mt-cat-create-buffer))))

(defun weblog-retrieve-post (&optional post-id)
  "*Retrieves a post for a given weblog post id."
  (interactive)
  (create-post-buffer 
   (mwa-get-post (or post-id (read-from-minibuffer "Post Id: ")))))

(defun weblog-retrieve-recent-posts (&optional num)
  "*Retrieve a list of recent posts, puts in a buffer for further editing."
  (interactive "P")
  (create-posts-buffer (mwa-get-recent-posts (or num weblog-post-count))))

(defun weblog-edit-post-at-point ()
  "Edit the post at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(create-post-buffer (mwa-get-post (match-string 1)))
      (error "Couldn't determine post number"))))

(defun weblog-submit-publish ()
  "Save and publish post regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '1))

(defun weblog-submit-no-publish ()
  "Save without publish regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '0))

(defun weblog-switch-weblog (&optional id)
  "Convenient way to switch what weblog is posted to"
  (interactive)
  (setq weblog-id (or id (read-from-minibuffer "Blog Id: ")))
  (setq weblog-name (mt-get-weblog-name weblog-id)))

(defun weblog-auto-categories-p ()
  "Returns t if a categories buffer should be setup."
  (if (> weblog-auto-categories 1)
      (if (y-or-n-p "Set categories on this post? ")
	  t
	nil)
    (if (= weblog-auto-categories 1)
	t
      nil)))

(defun weblog-allow-comments-p ()
  "Returns t if comments should be allowed for this post."
  (if (> weblog-allow-comments 1)
      (if (y-or-n-p "Allow comments on this post? ")
	  '1
	'0)
    weblog-allow-comments))

(defun weblog-allow-pings-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-allow-pings 1)
      (if (y-or-n-p "Allow pings on this post? ")
	  '1
	'0)
    weblog-allow-pings))

(defun weblog-convert-breaks-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-convert-breaks 1)
      (if (y-or-n-p "Convert line breaks on this post? ")
	  '1
	'0)
    weblog-convert-breaks))

(defun weblog-go-to-body ()
  "Moves point to beginning of post body."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-post-marker))

(defun weblog-go-to-excerpt ()
  "Moves point to beginning of excerpt."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-excerpt-marker))

(defun weblog-go-to-extended ()
  "Moves point to beginning of extended entry."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-extended-marker))

(defun weblog-add-excerpt-p ()
  "Return t if a block for an excerpt should be added to this post."
  (if (> weblog-post-buffer-excerpt 1)
      (if (y-or-n-p "Add an excerpt block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-excerpt))

(defun weblog-add-extended-p ()
  "Return t if a block for an extended entry should be added to this post."
  (if (> weblog-post-buffer-extended 1)
      (if (y-or-n-p "Add an extended entry block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-extended))

(defun create-posts-buffer (posts)
  "Creates a listing of retrieved posts"
  ; Needs to add a key binding for return to edit a post maybe
  (switch-to-buffer (generate-new-buffer "*weblog-posts*"))
  (insert "Recent posts:\n\n")
  (mapcar 
   (lambda (post)
     (setq post-id (cdr (assoc "postid" post)))
     (setq post-title (cdr (assoc "title" post)))
     (setq post-body (cdr (assoc "description" post)))
     (insert post-id)
     (insert " ")
     (insert post-title)
     (insert "\n"))
   posts)
  (weblog-mode)
  (goto-char (point-min)))
	  
(defun create-post-buffer (post)
  "Creates buffer filled with post info"
  ;; so we should have a struct in post
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (setq post-comments-allowed (cdr (assoc "mt_allow_comments" post)))
  (setq post-pings-allowed (cdr (assoc "mt_allow_pings" post)))
  (setq post-convert_breaks (cdr (assoc "mt_convert_breaks" post)))
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name post-id post-comments-allowed post-pings-allowed)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert (mt-clean-body post-body))
  (insert "\n")
  (insert weblog-end-post-marker)
  (if post-extended
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if post-excerpt
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker)))
  (weblog-go-to-body)
  (end-of-line)
  (weblog-mode))

(defun get-post-buffer-name (&optional post-id comments pings)
  (setq log-name (mt-get-weblog-name weblog-id))
  (if comments
      (setq comment-string "Com: Y")
    (if post-id
	(setq comment-string "Com: N")
      (cond 
       ((= weblog-allow-comments 2)
	(setq comment-string "Com: ?"))
       ((= weblog-allow-comments 1)
	(setq comment-string "Com: Y"))
       ((= weblog-allow-comments 0)
	(setq comment-string "Com: N")))))
  (if pings
      (setq ping-string "TB: Y")
    (if post-id
	(setq ping-string "TB: N")
      (cond 
       ((= weblog-allow-pings 2)
	(setq ping-string "TB: ?"))
       ((= weblog-allow-pings 1)
	(setq ping-string "TB: Y"))
       ((= weblog-allow-pings 0)
	(setq ping-string "TB: N")))))
  (if post-id
      (concat "*post " post-id " (" log-name ") " comment-string " " ping-string "*") ; need to check if numberp?
    (concat "*post (" log-name ") " comment-string " " ping-string "*"))) ; stupid 

;; metaweblogapi implementations
(defun mwa-new-post (&optional publish)
  "Makes a new post via metaWeblogAPI newPost command"
  (xml-rpc-method-call 
   weblog-url 
   'metaWeblog.newPost 
   weblog-id 
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-edit-post (&optional publish)
  "Edits a post via metaWeblogAPI editPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.editPost
   (weblog-post-id)
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-get-post (post-id)
  "Gets a single post via metaWeblogAPI getPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getPost
   post-id
   weblog-username
   weblog-password))

(defun mwa-get-recent-posts (number-of-posts)
  "Gets specified number of recent posts via metaWeblogAPI getRecentPosts command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getRecentPosts
   weblog-id
   weblog-username
   weblog-password
   number-of-posts))

;; MovableType XMLRPC implementation - category stuff

(defun mt-get-category-list ()
  "Gets list of categories for a weblog via mt API getCategoryList command"
  (xml-rpc-method-call
   weblog-url
   'mt.getCategoryList
   weblog-id
   weblog-username
   weblog-password))

(defun mt-get-post-categories (&optional post-id)
  "Gets categories for a post via mt API getPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.getPostCategories
   (or post-id (weblog-post-id))
   weblog-username
   weblog-password))

(defun mt-set-post-categories (post-id post-categories)
  "Sets categories for a post via mt API setPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.setPostCategories
   post-id
   weblog-username
   weblog-password
   post-categories))

(defun mt-get-trackback-pings ()
  "Retrieves trackback pings for an entry, if any."
  (xml-rpc-method-call
   weblog-url
   'mt.getTrackbackPings
   (weblog-post-id)))

(defun mt-publish-post (&optional post-id)
  "Rebuild the static files related to an entry."
  (xml-rpc-method-call
   weblog-url
   'mt.publishPost
   (or post-id (weblog-post-id))))

;; blogger api implementation
(defun blogger-get-users-blogs ()
  "Retrieves info about current users blogs"
  (xml-rpc-method-call
   weblog-url
   'blogger.getUsersBlogs
   '""
   weblog-username
   weblog-password))

;; support utility functions
(defun weblog-post-title ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Title:[ \t]*\\(.*\\)$" nil t)
	  (setq post-title (match-string 1))
	(read-from-minibuffer "Post Title: " post-title))
      (xml-rpc-encode post-title))))

(defun weblog-post-body ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-post-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-post-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	nil))))

(defun weblog-post-excerpt ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-excerpt-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-excerpt-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun weblog-post-extended ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-extended-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-extended-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun xml-rpc-encode (string)
  "Replaces < with &lt; and & with &amp;"
  (let (buf)
    (save-excursion
      (unwind-protect
	  (progn
	    (setq buf (get-buffer-create " *xml-rpc-escape*"))
	    (set-buffer buf)
	    (erase-buffer)
	    (insert-string string)
	    
	    ;; This whole section is a massive massive hack
	    (goto-char (point-min))
	    (while (re-search-forward "&" nil t)
	      (replace-match "&amp;" nil nil)) ;; can't have bare &
	    (goto-char (point-min))
	    (while (re-search-forward "<" nil t)
	      (replace-match "&lt;" nil nil))  ;; can't have bare <
	    (buffer-string))
	(if buf (kill-buffer buf))))))

(defun wrap-paragraphs (string)
    (save-excursion
      (unwind-protect
	  (progn
	    (with-temp-buffer
	      (insert-string string)
	      (goto-char (point-min))
	      ;; only try and wrap if there's something non-empty to wrap
	      (if (re-search-forward "[^ \n\t\r]" nil t)
		  (lambda
		    (goto-char (point-max))
		    ;; blecherous hack here
		    (while (mt-looking-back-at "\n")
		      (delete-backward-char 1))
		    (insert "\n")
		    (goto-char (point-min))
		    (while (not (eq (point) (point-max)))
		      (start-of-paragraph-text)
		      (if (not (looking-at "<p>"))  
			  (insert "<p>")) 
		      (end-of-paragraph-text) 
		      (if (not (mt-looking-back-at "</p>"))  
			  (insert "</p>"))
		      (end-of-paragraph-text))))
		    (buffer-string))))))
  

(defun weblog-post-id ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Post Id:[ \t]*\\([0-9]*\\).*$" nil t)
	  (setq post-id (match-string 1))
	(setq post-id nil)))))

(defun weblog-insert-post-contents (post)
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert post-body)
  (insert "\n")
  (insert weblog-end-post-marker)
  (if (and (not (string= post-extended "")) post-extended)
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if (and (not (string= post-excerpt "")) post-excerpt)
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker))))
  
(defun weblog-refresh-buffer (&optional post-id)
  "Refreshes content of current buffer with whatever mt server has."
  (interactive)
  (setq pm (point-max))
  (goto-char (point-max))
  (if (stringp post-id)
      (setq id post-id)
    (setq id (weblog-post-id)))
  (weblog-insert-post-contents
   (mwa-get-post id))
  (delete-region (point-min) pm)
  (weblog-go-to-body))

(defun new-postp ()
  "Return t if buffer is a new post."
  (not (weblog-post-id)))

(defun publishp ()
  "Return 1 if publish, 0 otherwise."
  (if weblog-publish-on-save
      (setq publish '1)
    (setq publish '0)))

(defun mt-looking-back-at (regexp &optional bound)
  "Return t if text before point matches REGEXP.
Modifies the match data. If supplied, BOUND means not to look farther
back that that many characters before point. Otherwise, it defaults to
\(length REGEXP), which is good enough when REGEXP is a simple
string."
  ;; taken from mmm-mode - mmm-utils.el
  (eq (point)
      (save-excursion
        (and (re-search-backward regexp
               (- (point) (or bound (length regexp)))
               t)
             (match-end 0)))))

(defun mt-clean-body (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward "&#xd;" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-get-weblog-name (&optional log-id)
  "retrieves name of a weblog given an id, either from local file or net"
  (if (mt-weblog-file-exists-p (or log-id weblog-id))
      (mt-read-weblog-name (or log-id weblog-id))
    (mt-store-weblog-name (mt-fetch-weblog-name (or log-id weblog-id)))))

(defun mt-weblog-file-exists-p (log-id)
  "Tests to see if the weblog name file exists"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (file-exists-p weblog-file-name))

(defun mt-read-weblog-name (log-id)
  "Reads the weblog name from a file"
  (with-temp-buffer
    (insert-file-contents (concat weblog-local-save-dir "/" "weblog." log-id))
    (goto-char (point-min))
    (while (re-search-forward "\n" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-store-weblog-name (weblog-name)
  "Stores the weblog name in a file"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (if (not (file-directory-p weblog-local-save-dir))
      (make-directory weblog-local-save-dir))
  (with-temp-buffer
    (insert weblog-name)
    (insert "\n")
    (append-to-file (point-min) (point-max) weblog-file-name))
  weblog-name)

(defun mt-fetch-weblog-name (log-id)
  "Fetches weblog name from server using XML-RPC"
  (setq weblog-name nil)
  (mapc
   (lambda (log-info)
     (if (string= (or log-id weblog-id) (cdr (assoc "blogid" log-info)))
	 (setq weblog-name (cdr (assoc "blogName" log-info)))))
   (blogger-get-users-blogs))
  weblog-name)


;; category handling stuff

;; Here's the basics of what I'd like to do:
;; - have a buffer created (probably split the window) that gives the
;;   categories available
;; - allow user to mark primary and secondary categories. Only one
;;   primary category is allowed, as many secondary as necessary.
;; - an update command that sets the categories on a post.
(require 'cookie)

(defvar mt-cat-col nil)

(defvar mt-cat-buf "*Category Selection*")

(defun mt-cat-create-buffer (&optional post-id)
  "Creates a buffer filled with categories."
  (interactive)
  (setq post-id (or post-id (or (weblog-get-post-id-at-point) (weblog-post-id))))
  (split-window)
  (save-excursion
    (set-buffer (get-buffer-create mt-cat-buf))
    (setq buffer-read-only nil)
    (erase-buffer))
  (setq mt-cat-col (mt-cat-create-cookie-collection post-id))
  (mt-cat-enter-cookies post-id (mt-get-post-categories post-id))
  (other-window 1)
  (switch-to-buffer mt-cat-buf)
  
  (weblog-cat-mode))

(defun weblog-get-post-id-at-point ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(match-string 1))))


(defun mt-cat-create-cookie-collection (post-id)
  (collection-create
   mt-cat-buf
  (function mt-cat-pp)
  (concat "Post " post-id " category selection\n") 
  "\n+ Primary category\n- Secondary category" 0))

(defun mt-cat-enter-cookies (post-id post-categories)
  (collection-append-cookies 
   mt-cat-col
   (mapcar 
    (lambda (category)
      (setq cat-id 
	    (cdr (assoc "categoryId" category)))
      (setq cat-primary 
	    (mt-post-primary post-categories))
      (setq cat-secondary 
	    (mt-post-secondary post-categories))
      (list (cons "cat-id" cat-id)
	    (cons "cat-name" 
		  (cdr (assoc "categoryName" category)))
	    (cons "primary" 
		  (is-primary-p cat-id cat-primary))
	    (cons "secondary" 
		  (is-secondary-p cat-id cat-secondary))))
    (mt-get-category-list))))

(defun is-primary-p (cat-id cat-primary)
  (if (string= cat-id cat-primary)
      t
    nil))

(defun is-secondary-p (cat-id cat-secondary)
  (if (member cat-id cat-secondary)
      t
    nil))

(defun mt-post-primary (post-categories)
  "Returns the category id of the primary category for a post"
  ;; this is a bit hackish and inefficient, as we'll continue looping
  ;; over the list of categories even after we've got our primary
  (let (primary)
    (mapc
     (lambda (category)
       (if (cdr (assoc "isPrimary" category))
	   (setq primary (cdr (assoc "categoryId" category)))))
     post-categories)
    primary))
       
(defun mt-post-secondary (post-categories)
  "Returns a list of the category id(s) of the secondary categories
  for a post"
  (interactive)
  (mapcar
   (lambda (category)
     (if (not (cdr (assoc "isPrimary" category)))
	 (cdr (assoc "categoryId" category))
       nil))
   post-categories))

(defun mt-cat-get-tin (pos)
  (interactive "d")
  (mt-cat-mark-primary cookie))

(defun mt-cat-toggle-primary (pos)
  "toggles primary setting of this category"
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	 (cookie (tin-cookie mt-cat-col tin)))
  (cookie-map
   (function (lambda (cat)
	       ;; if this is our primary cat, toggle it
	       ;; othewise, mark the primary field nil
	       ;; this should enforce only one primary cat at a time,
	       ;; also sets secondary to nil
	       (if (string= (cdr (assoc "cat-id" cookie)) (cdr (assoc "cat-id" cat)))
		   (progn
		     (setcdr (assoc "primary" cat) (mt-cat-toggle (cdr (assoc "primary" cat))))
		     (setcdr (assoc "secondary" cat) nil))
		 (setcdr (assoc "primary" cat) nil))
	       t))
   mt-cat-col)))

(defun mt-cat-toggle-secondary (pos)
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	(cookie (tin-cookie mt-cat-col tin)))

  (setcdr (assoc "secondary" cookie) (mt-cat-toggle (cdr (assoc "secondary" cookie))))
  (setcdr (assoc "primary" cookie) nil)
  (collection-refresh mt-cat-col)
  (goto-char pos))) ; lazy, but why test?


(defun mt-cat-toggle (bool)
  (if bool
      nil
    t))

(defun mt-cat-update ()
  "Sets the category information on the post on the server"
  (interactive)
  (mt-set-post-categories (mt-cat-post-id) (mt-cats-as-array))
  (bury-buffer)
  (delete-window))

(defun mt-cat-post-id ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^Post \\([0-9]*\\).*" nil t)
	(match-string 1))))

(defun mt-cats-as-array ()
  (interactive)
  (mt-cat-get-struct (append (get-primary-cat) (get-secondary-cats))))

(defun mt-cat-get-struct (cats)
  (mapcar 
   (lambda (cat)
     (list (cons "categoryId" (cdr (assoc "cat-id" cat)))))
   cats))
  
(defun get-primary-cat ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-primary-p)))

(defun get-secondary-cats ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-secondary-p)))

(defun is-marked-primary-p (cat)
  (if (cdr (assoc "primary" cat))
      t
    nil))

(defun is-marked-secondary-p (cat)
  (if (cdr (assoc "secondary" cat))
      t
    nil))
  
(defun mt-cat-pp (mt-cat-info)
  "pretty printer for cookie collection"
  (insert "[")
  (cond 
   ((cat-info-primary-p mt-cat-info)
    (insert "+"))
   ((cat-info-secondary-p mt-cat-info)
    (insert "-"))
   (t (insert " ")))
  (insert (concat (cdr (assoc "cat-id" mt-cat-info)) " ]"))
  (insert " ")
  (insert (cdr (assoc "cat-name" mt-cat-info))))

(defun cat-info-primary-p (mt-cat-info)
  (if (cdr (assoc "primary" mt-cat-info))
      t
    nil))

(defun cat-info-secondary-p (mt-cat-info)
  (if (cdr (assoc "secondary" mt-cat-info))
      t
    nil))

(provide 'mt)

;;; mt.el ends here

--=-=-=


-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org

--=-=-=--


From mt-el@marginalia.org  Mon Oct 21 04:58:52 2002
From: mt-el@marginalia.org (Jack Moffitt)
Date: Sun, 20 Oct 2002 21:58:52 -0600
Subject: [mt-el] beta code!
In-Reply-To: <87of9opihb.fsf@telus.net>
References: <87elakr539.fsf@telus.net> <20021021023632.GR10159@i.cantcode.com> <878z0sqyyf.fsf@telus.net> <87of9opihb.fsf@telus.net>
Message-ID: <20021021035852.GV10159@i.cantcode.com>

> > Hmm, I think my detection routines need a little work. That was
> > happening to me in xemacs, but I thought I'd fixed it. Back to the
> > salt mines.
> 
> Think I've got this one licked. Let me know.

Yep, not seeing the extra fields anymore.

Thanks,
jack.

From mt-el@marginalia.org  Mon Oct 21 05:12:03 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Sun, 20 Oct 2002 21:12:03 -0700
Subject: [mt-el] beta #3
Message-ID: <87bs5oph0s.fsf@telus.net>

--=-=-=

Hey all,

Small thinko fixed in the attached. (Thanks Jack!)


--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=mt.el
Content-Transfer-Encoding: 8bit

;; mt.el - Elisp package for posting to an MT blog via XML-RPC
;; $Id: mt.el,v 1.21 2002/10/20 23:28:41 was Exp $

;; Copyright (C) 2002 Bill Stilwell

;; Author: Bill Stilwell <bill@marginalia.org>
;; Version: 0.99
;; Created: August 7 2002
;; 
;; This file is NOT (yet) part of GNU Emacs.

;; This 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, or (at your option)
;; any later version.

;; this software 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; This packages enables you to create new posts and edit old posts on
;; your Movable Type Weblog. It may be expanded so that any weblog
;; tool that supports the metaWeblog API can be used.

;;; THANKS & CREDIT:
;; mt.el is based heavily on the blogger.el package by Mark
;; A. Hershberger (http://mah.everybody.org/hacks/emacs/blogger.el.txt)
;; and Jamie Zawinski's LiveJournal package
;; (http://www.jwz.org/hacks/jwz-lj.el). All the good parts here are
;; probably from them; the parts that screw up are mine.


;;; INSTALLATION:
;;
;; To install, put mt.el somewhere in your load path:
;; e.g.: (add-to-list 'load-path "~/elisp")

;; and add these lines to your .emacs or ~/.xemacs/init.el:
;; (require 'mt)
;; (global-set-key "\C-cwc" 'weblog-create-post)
;; (global-set-key "\C-cwr" 'weblog-retrieve-recent-posts)
;; (global-set-key "\C-cwg" 'weblog-retrieve-post)
;;
;; This will load mt.el and bind C-c w c to the post creation command.
;;
;; You will also need to set a few variables, either in your .emacs or
;; via the customization system.

;; With customize:

;; Type M-x customize-group <RET> weblog <RET>. You will need to set:
;;
;; Id - This is the id of your weblog. You can get this from the query
;; string when you go into the movable type main menu for your
;; weblog. You should have something like:
;; 'mt.cgi?__mode=menu&blog_id=1'. In this example, the Id would be 1.
;;
;; Username - username
;;
;; Password - password
;;
;; Url - complete URL to access the mt xmlrpc service. This is likely
;; to be something like:
;; http://www.example.com/PATH/TO/MT/mt-xmlrpc.cgi
;;
;; You can also set Post Count to something other than the
;; default. This value is used when no count is provided to the
;; retrieve recent posts command.
;;
;; If you wish, you can set these values directly in your .emacs:
;; (setq weblog-id "1")
;; (setq weblog-username "My Username")
;; (setq weblog-password "easy")
;; (setq weblog-url "http://www.example.com/mt/mt-xmlrpc.cgi")
;; (setq weblog-post-count 5)
;; (setq weblog-publish-on-save t)
;;
;;; USING mt.el
;; C-c w c -- create a new buffer for a new post

;; C-c w r -- retrieve a set of recent posts. If a prefix argument is
;;            supplied (e.g. C-u 3 C-c w r), that number of posts will
;;            be fetched; otherwise the value of weblog-post-count is
;;            used. A new buffer will open with a list of posts, hit
;;            return on any of the posts to edit that post.

;; C-c w g -- get a particular post. You will be prompted for the post
;;            id.

;; C-c C-c -- save it! Will publish if weblog-publish-on-save is
;;            true.

;; C-c C-s -- save without publish, regardless of
;;            weblog-publish-on-save setting.

;; C-c C-p -- save and publish, regardless weblog-publish-on-save setting.

;; C-c C-e -- in post list, edit post at point

;; C-c C-r -- refresh current post buffer

;;; Requirements:

;; requires xml-rpc.el 
;; http://www.marginalia.org/code/xml-rpc.el
;; http://elisp.info/package/xml-rpc/xml-rpc.el
;; and xml.el
;; ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el

;; elib is required (http://www.gnu.org/software/elib/elib.html)

;; if you're using emacs, you may need to put (require 'cl) in your
;; .emacs (thanks to Shawn Ledbetter for pointing this out).

;; mt.el uses the metaweblog API (see http://www.xmlrpc.com/metaWeblogApi
;; and movabletype's support for it:
;; http://www.movabletype.org/docs/mtmanual_programmatic.html#xmlrpc%20api.
;;
;; If your weblog does not support these tools, this package will NOT
;; work. To see if your movable type weblog can use XML-RPC, load
;; mt-check.cgi. If you see the following lines, you should be ok:
;;    LWP::UserAgent...
;;        Your server has LWP::UserAgent installed.

;;    SOAP::Lite...
;;        Your server has SOAP::Lite installed.
;; 
;; If not, you will have to install them; see MT's installation manual
;; for instructions.
;;
;; There are currently issues with line breaks. If you set up MT to
;; automatically convert linebreaks and you have auto-fill on in your
;; entry buffer (or fill before submitting), you will end up breaking
;; entries where auto fill wraps tags in the middle. My current
;; recommendation is to turn this off in your MT preferences and have
;; mt.el wrap your paragraphs in <p> tags. However, if you really
;; don't like this, turn off weblog-wrap-paras in customize

;; The publish flag

;; The default behaviour for MT's XML-RPC API is to always set a
;; post's status to Publish. From comments in XMLRPCServer.pm:

;; ## In 2.1 we changed the behavior of the $publish flag. Previously, 
;; ## it was used to determine the post status. That was a bad idea. 
;; ## So now entries added through XML-RPC are always set to publish, 
;; ## unless the user has set "NoPublishMeansDraft 1" in mt.cfg, which 
;; ## enables the old behavior. 

;; So the _default_ behaviour when setting publish to nil (either in
;; your configuration settings or with an explicit
;; weblog-submit-no-publish) is to create or save a post with a status
;; of publish but no site rebuild. If you change the setting in your
;; mt.cfg, the same action will set the status accordingly.

;; TODO 

;; BUGS

;; Paragraph wrapping breaks on the last paragraph if there isn't a
;; newline at the end. Current hack fix is to add newline at the end.

;;; CODE

(require 'xml-rpc)

(defgroup weblog nil
  "Emacs interface to the metaWeblogAPI."
  :group 'emacs)

(defcustom weblog-id nil
  "Id for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-username nil
  "Username for this weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-password nil
  "Password for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-url nil
  "Complete url to your XMLRPC service."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-count 5
  "Default number of posts to retrieve if no count supplied."
  :group 'weblog
  :type 'integer)

(defcustom weblog-publish-on-save t
  "If t, publish on save."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-wrap-paras t
  "If t, mt.el will wrap paragraphs in <p> tags, and you should turn this
  functionality off in MT. If nil, no wrapping will be done, but you
  should turn off auto-fill in your post buffers."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-local-save-dir "~/.mt"
  "Used to cache weblog name and local copies of posts"
  :group 'weblog
  :type 'directory)

(defcustom weblog-auto-categories 0
  "If t, mt will automatically prompt you to set categories on new posts."
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-comments 1
  "Default value for the allow-comments field. Can be Yes, No, or Ask"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-pings 1
  "Default value for the allow-pings field. If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-convert-breaks 0
  "Should MT convert line breaks? If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-post-marker "--post follows this line--\n"
  "String to demarcate title and post."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-post-marker "--end of post--\n"
  "String to mark end of main post body."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-extended 0
  "Add an extended entry section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-extended-marker "--extended entry follows this line--\n"
  "String to mark beginning of extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-extended-marker "--end of extended--\n"
  "String to mark end of an extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-excerpt 0
  "Add an excerpt section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-excerpt-marker "--excerpt follows this line--\n"
  "String to mark beginning of excerpt."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-excerpt-marker "--end of excerpt--\n"
  "String to mark end of excerpt."
  :group 'weblog
  :group 'string)


(defvar mt-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-mode-map))
    (define-key map "\C-c\C-c" 'weblog-submit-post)
    (define-key map "\C-c\C-s" 'weblog-submit-publish)
    (define-key map "\C-c\C-p" 'weblog-submit-no-publish)
    (define-key map "\C-c\C-e" 'weblog-edit-post-at-point)
    (define-key map "\C-c\C-r" 'weblog-refresh-buffer)
    (define-key map "\C-c\C-d" 'mt-cat-create-buffer)
    map))

(defvar mt-cat-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-cat-mode-map))
    (suppress-keymap map)
    (define-key map "p" 'mt-cat-toggle-primary)
    (define-key map "s" 'mt-cat-toggle-secondary)
    (define-key map "\C-c\C-c" 'mt-cat-update)
    map))

(defvar weblog-mode-hook nil
  "Hook run after starting up weblog mode.")

(defvar weblog-new-post-hook nil
  "Hook to run when visiting a new post buffer")

(defun weblog-mode ()
  "Major mode for editing posts for a weblog."
  (interactive)
  (text-mode)
  (use-local-map mt-mode-map)
  (setq mode-name "weblog")
  (setq major-mode 'weblog-mode)
  ;; what would be nice for hooks is to have it prompt for
  ;; title/category or not depending on user preference
  (run-hooks 'weblog-mode-hook))

(defun weblog-cat-mode ()
  "Major mode for editing categories on a post."
  (interactive)
  (text-mode)
  (use-local-map mt-cat-mode-map)
  (setq mode-name "weblog-cat")
  (setq major-mode 'weblog-cat-mode)
  (setq buffer-read-only t))

(defun weblog-create-post ()
  "*Compose a weblog post."
  (interactive)
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Title: \n")
  (insert weblog-begin-post-marker)
  (insert "\n\n")
  (insert weblog-end-post-marker)
  (if (> (weblog-add-extended-p) 0)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker)))
  (if (> (weblog-add-excerpt-p) 0)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker)))
  (beginning-of-buffer)
  (end-of-line)
  (weblog-mode)
  (run-hooks 'weblog-new-post-hook))

(defun weblog-submit-post (&optional publish)
  "*Publish current message."
  (interactive)
  (setq new-post (new-postp))
  (weblog-refresh-buffer
  (if new-post
      (mwa-new-post publish)
    (mwa-edit-post publish)))
  (if new-post
      (if (weblog-auto-categories-p)
	  (mt-cat-create-buffer))))

(defun weblog-retrieve-post (&optional post-id)
  "*Retrieves a post for a given weblog post id."
  (interactive)
  (create-post-buffer 
   (mwa-get-post (or post-id (read-from-minibuffer "Post Id: ")))))

(defun weblog-retrieve-recent-posts (&optional num)
  "*Retrieve a list of recent posts, puts in a buffer for further editing."
  (interactive "P")
  (create-posts-buffer (mwa-get-recent-posts (or num weblog-post-count))))

(defun weblog-edit-post-at-point ()
  "Edit the post at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(create-post-buffer (mwa-get-post (match-string 1)))
      (error "Couldn't determine post number"))))

(defun weblog-submit-publish ()
  "Save and publish post regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '1))

(defun weblog-submit-no-publish ()
  "Save without publish regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '0))

(defun weblog-switch-weblog (&optional id)
  "Convenient way to switch what weblog is posted to"
  (interactive)
  (setq weblog-id (or id (read-from-minibuffer "Blog Id: ")))
  (setq weblog-name (mt-get-weblog-name weblog-id)))

(defun weblog-auto-categories-p ()
  "Returns t if a categories buffer should be setup."
  (if (> weblog-auto-categories 1)
      (if (y-or-n-p "Set categories on this post? ")
	  t
	nil)
    (if (= weblog-auto-categories 1)
	t
      nil)))

(defun weblog-allow-comments-p ()
  "Returns t if comments should be allowed for this post."
  (if (> weblog-allow-comments 1)
      (if (y-or-n-p "Allow comments on this post? ")
	  '1
	'0)
    weblog-allow-comments))

(defun weblog-allow-pings-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-allow-pings 1)
      (if (y-or-n-p "Allow pings on this post? ")
	  '1
	'0)
    weblog-allow-pings))

(defun weblog-convert-breaks-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-convert-breaks 1)
      (if (y-or-n-p "Convert line breaks on this post? ")
	  '1
	'0)
    weblog-convert-breaks))

(defun weblog-go-to-body ()
  "Moves point to beginning of post body."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-post-marker))

(defun weblog-go-to-excerpt ()
  "Moves point to beginning of excerpt."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-excerpt-marker))

(defun weblog-go-to-extended ()
  "Moves point to beginning of extended entry."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-extended-marker))

(defun weblog-add-excerpt-p ()
  "Return t if a block for an excerpt should be added to this post."
  (if (> weblog-post-buffer-excerpt 1)
      (if (y-or-n-p "Add an excerpt block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-excerpt))

(defun weblog-add-extended-p ()
  "Return t if a block for an extended entry should be added to this post."
  (if (> weblog-post-buffer-extended 1)
      (if (y-or-n-p "Add an extended entry block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-extended))

(defun create-posts-buffer (posts)
  "Creates a listing of retrieved posts"
  ; Needs to add a key binding for return to edit a post maybe
  (switch-to-buffer (generate-new-buffer "*weblog-posts*"))
  (insert "Recent posts:\n\n")
  (mapcar 
   (lambda (post)
     (setq post-id (cdr (assoc "postid" post)))
     (setq post-title (cdr (assoc "title" post)))
     (setq post-body (cdr (assoc "description" post)))
     (insert post-id)
     (insert " ")
     (insert post-title)
     (insert "\n"))
   posts)
  (weblog-mode)
  (goto-char (point-min)))
	  
(defun create-post-buffer (post)
  "Creates buffer filled with post info"
  ;; so we should have a struct in post
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (setq post-comments-allowed (cdr (assoc "mt_allow_comments" post)))
  (setq post-pings-allowed (cdr (assoc "mt_allow_pings" post)))
  (setq post-convert_breaks (cdr (assoc "mt_convert_breaks" post)))
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name post-id post-comments-allowed post-pings-allowed)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert (mt-clean-body post-body))
  (insert "\n")
  (insert weblog-end-post-marker)
  (if post-extended
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if post-excerpt
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker)))
  (weblog-go-to-body)
  (end-of-line)
  (weblog-mode))

(defun get-post-buffer-name (&optional post-id comments pings)
  (setq log-name (mt-get-weblog-name weblog-id))
  (if comments
      (setq comment-string "Com: Y")
    (if post-id
	(setq comment-string "Com: N")
      (cond 
       ((= weblog-allow-comments 2)
	(setq comment-string "Com: ?"))
       ((= weblog-allow-comments 1)
	(setq comment-string "Com: Y"))
       ((= weblog-allow-comments 0)
	(setq comment-string "Com: N")))))
  (if pings
      (setq ping-string "TB: Y")
    (if post-id
	(setq ping-string "TB: N")
      (cond 
       ((= weblog-allow-pings 2)
	(setq ping-string "TB: ?"))
       ((= weblog-allow-pings 1)
	(setq ping-string "TB: Y"))
       ((= weblog-allow-pings 0)
	(setq ping-string "TB: N")))))
  (if post-id
      (concat "*post " post-id " (" log-name ") " comment-string " " ping-string "*") ; need to check if numberp?
    (concat "*post (" log-name ") " comment-string " " ping-string "*"))) ; stupid 

;; metaweblogapi implementations
(defun mwa-new-post (&optional publish)
  "Makes a new post via metaWeblogAPI newPost command"
  (xml-rpc-method-call 
   weblog-url 
   'metaWeblog.newPost 
   weblog-id 
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-edit-post (&optional publish)
  "Edits a post via metaWeblogAPI editPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.editPost
   (weblog-post-id)
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-get-post (post-id)
  "Gets a single post via metaWeblogAPI getPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getPost
   post-id
   weblog-username
   weblog-password))

(defun mwa-get-recent-posts (number-of-posts)
  "Gets specified number of recent posts via metaWeblogAPI getRecentPosts command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getRecentPosts
   weblog-id
   weblog-username
   weblog-password
   number-of-posts))

;; MovableType XMLRPC implementation - category stuff

(defun mt-get-category-list ()
  "Gets list of categories for a weblog via mt API getCategoryList command"
  (xml-rpc-method-call
   weblog-url
   'mt.getCategoryList
   weblog-id
   weblog-username
   weblog-password))

(defun mt-get-post-categories (&optional post-id)
  "Gets categories for a post via mt API getPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.getPostCategories
   (or post-id (weblog-post-id))
   weblog-username
   weblog-password))

(defun mt-set-post-categories (post-id post-categories)
  "Sets categories for a post via mt API setPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.setPostCategories
   post-id
   weblog-username
   weblog-password
   post-categories))

(defun mt-get-trackback-pings ()
  "Retrieves trackback pings for an entry, if any."
  (xml-rpc-method-call
   weblog-url
   'mt.getTrackbackPings
   (weblog-post-id)))

(defun mt-publish-post (&optional post-id)
  "Rebuild the static files related to an entry."
  (xml-rpc-method-call
   weblog-url
   'mt.publishPost
   (or post-id (weblog-post-id))))

;; blogger api implementation
(defun blogger-get-users-blogs ()
  "Retrieves info about current users blogs"
  (xml-rpc-method-call
   weblog-url
   'blogger.getUsersBlogs
   '""
   weblog-username
   weblog-password))

;; support utility functions
(defun weblog-post-title ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Title:[ \t]*\\(.*\\)$" nil t)
	  (setq post-title (match-string 1))
	(read-from-minibuffer "Post Title: " post-title))
      (xml-rpc-encode post-title))))

(defun weblog-post-body ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-post-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-post-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	nil))))

(defun weblog-post-excerpt ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-excerpt-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-excerpt-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun weblog-post-extended ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-extended-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-extended-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun xml-rpc-encode (string)
  "Replaces < with &lt; and & with &amp;"
  (let (buf)
    (save-excursion
      (unwind-protect
	  (progn
	    (setq buf (get-buffer-create " *xml-rpc-escape*"))
	    (set-buffer buf)
	    (erase-buffer)
	    (insert-string string)
	    
	    ;; This whole section is a massive massive hack
	    (goto-char (point-min))
	    (while (re-search-forward "&" nil t)
	      (replace-match "&amp;" nil nil)) ;; can't have bare &
	    (goto-char (point-min))
	    (while (re-search-forward "<" nil t)
	      (replace-match "&lt;" nil nil))  ;; can't have bare <
	    (buffer-string))
	(if buf (kill-buffer buf))))))

(defun wrap-paragraphs (string)
    (save-excursion
      (unwind-protect
	  (progn
	    (with-temp-buffer
	      (insert-string string)
	      (goto-char (point-min))
	      ;; only try and wrap if there's something non-empty to wrap
	      (if (re-search-forward "[^ \n\t\r]" nil t)
		  (progn
		    (goto-char (point-max))
		    ;; blecherous hack here
		    (while (mt-looking-back-at "\n")
		      (delete-backward-char 1))
		    (insert "\n")
		    (goto-char (point-min))
		    (while (not (eq (point) (point-max)))
		      (start-of-paragraph-text)
		      (if (not (looking-at "<p>"))  
			  (insert "<p>")) 
		      (end-of-paragraph-text) 
		      (if (not (mt-looking-back-at "</p>"))  
			  (insert "</p>"))
		      (end-of-paragraph-text))))
		    (buffer-string))))))
  

(defun weblog-post-id ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Post Id:[ \t]*\\([0-9]*\\).*$" nil t)
	  (setq post-id (match-string 1))
	(setq post-id nil)))))

(defun weblog-insert-post-contents (post)
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert post-body)
  (insert "\n")
  (insert weblog-end-post-marker)
  (if (and (not (string= post-extended "")) post-extended)
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if (and (not (string= post-excerpt "")) post-excerpt)
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker))))
  
(defun weblog-refresh-buffer (&optional post-id)
  "Refreshes content of current buffer with whatever mt server has."
  (interactive)
  (setq pm (point-max))
  (goto-char (point-max))
  (if (stringp post-id)
      (setq id post-id)
    (setq id (weblog-post-id)))
  (weblog-insert-post-contents
   (mwa-get-post id))
  (delete-region (point-min) pm)
  (weblog-go-to-body))

(defun new-postp ()
  "Return t if buffer is a new post."
  (not (weblog-post-id)))

(defun publishp ()
  "Return 1 if publish, 0 otherwise."
  (if weblog-publish-on-save
      (setq publish '1)
    (setq publish '0)))

(defun mt-looking-back-at (regexp &optional bound)
  "Return t if text before point matches REGEXP.
Modifies the match data. If supplied, BOUND means not to look farther
back that that many characters before point. Otherwise, it defaults to
\(length REGEXP), which is good enough when REGEXP is a simple
string."
  ;; taken from mmm-mode - mmm-utils.el
  (eq (point)
      (save-excursion
        (and (re-search-backward regexp
               (- (point) (or bound (length regexp)))
               t)
             (match-end 0)))))

(defun mt-clean-body (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward "&#xd;" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-get-weblog-name (&optional log-id)
  "retrieves name of a weblog given an id, either from local file or net"
  (if (mt-weblog-file-exists-p (or log-id weblog-id))
      (mt-read-weblog-name (or log-id weblog-id))
    (mt-store-weblog-name (mt-fetch-weblog-name (or log-id weblog-id)))))

(defun mt-weblog-file-exists-p (log-id)
  "Tests to see if the weblog name file exists"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (file-exists-p weblog-file-name))

(defun mt-read-weblog-name (log-id)
  "Reads the weblog name from a file"
  (with-temp-buffer
    (insert-file-contents (concat weblog-local-save-dir "/" "weblog." log-id))
    (goto-char (point-min))
    (while (re-search-forward "\n" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-store-weblog-name (weblog-name)
  "Stores the weblog name in a file"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (if (not (file-directory-p weblog-local-save-dir))
      (make-directory weblog-local-save-dir))
  (with-temp-buffer
    (insert weblog-name)
    (insert "\n")
    (append-to-file (point-min) (point-max) weblog-file-name))
  weblog-name)

(defun mt-fetch-weblog-name (log-id)
  "Fetches weblog name from server using XML-RPC"
  (setq weblog-name nil)
  (mapc
   (lambda (log-info)
     (if (string= (or log-id weblog-id) (cdr (assoc "blogid" log-info)))
	 (setq weblog-name (cdr (assoc "blogName" log-info)))))
   (blogger-get-users-blogs))
  weblog-name)


;; category handling stuff

;; Here's the basics of what I'd like to do:
;; - have a buffer created (probably split the window) that gives the
;;   categories available
;; - allow user to mark primary and secondary categories. Only one
;;   primary category is allowed, as many secondary as necessary.
;; - an update command that sets the categories on a post.
(require 'cookie)

(defvar mt-cat-col nil)

(defvar mt-cat-buf "*Category Selection*")

(defun mt-cat-create-buffer (&optional post-id)
  "Creates a buffer filled with categories."
  (interactive)
  (setq post-id (or post-id (or (weblog-get-post-id-at-point) (weblog-post-id))))
  (split-window)
  (save-excursion
    (set-buffer (get-buffer-create mt-cat-buf))
    (setq buffer-read-only nil)
    (erase-buffer))
  (setq mt-cat-col (mt-cat-create-cookie-collection post-id))
  (mt-cat-enter-cookies post-id (mt-get-post-categories post-id))
  (other-window 1)
  (switch-to-buffer mt-cat-buf)
  
  (weblog-cat-mode))

(defun weblog-get-post-id-at-point ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(match-string 1))))


(defun mt-cat-create-cookie-collection (post-id)
  (collection-create
   mt-cat-buf
  (function mt-cat-pp)
  (concat "Post " post-id " category selection\n") 
  "\n+ Primary category\n- Secondary category" 0))

(defun mt-cat-enter-cookies (post-id post-categories)
  (collection-append-cookies 
   mt-cat-col
   (mapcar 
    (lambda (category)
      (setq cat-id 
	    (cdr (assoc "categoryId" category)))
      (setq cat-primary 
	    (mt-post-primary post-categories))
      (setq cat-secondary 
	    (mt-post-secondary post-categories))
      (list (cons "cat-id" cat-id)
	    (cons "cat-name" 
		  (cdr (assoc "categoryName" category)))
	    (cons "primary" 
		  (is-primary-p cat-id cat-primary))
	    (cons "secondary" 
		  (is-secondary-p cat-id cat-secondary))))
    (mt-get-category-list))))

(defun is-primary-p (cat-id cat-primary)
  (if (string= cat-id cat-primary)
      t
    nil))

(defun is-secondary-p (cat-id cat-secondary)
  (if (member cat-id cat-secondary)
      t
    nil))

(defun mt-post-primary (post-categories)
  "Returns the category id of the primary category for a post"
  ;; this is a bit hackish and inefficient, as we'll continue looping
  ;; over the list of categories even after we've got our primary
  (let (primary)
    (mapc
     (lambda (category)
       (if (cdr (assoc "isPrimary" category))
	   (setq primary (cdr (assoc "categoryId" category)))))
     post-categories)
    primary))
       
(defun mt-post-secondary (post-categories)
  "Returns a list of the category id(s) of the secondary categories
  for a post"
  (interactive)
  (mapcar
   (lambda (category)
     (if (not (cdr (assoc "isPrimary" category)))
	 (cdr (assoc "categoryId" category))
       nil))
   post-categories))

(defun mt-cat-get-tin (pos)
  (interactive "d")
  (mt-cat-mark-primary cookie))

(defun mt-cat-toggle-primary (pos)
  "toggles primary setting of this category"
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	 (cookie (tin-cookie mt-cat-col tin)))
  (cookie-map
   (function (lambda (cat)
	       ;; if this is our primary cat, toggle it
	       ;; othewise, mark the primary field nil
	       ;; this should enforce only one primary cat at a time,
	       ;; also sets secondary to nil
	       (if (string= (cdr (assoc "cat-id" cookie)) (cdr (assoc "cat-id" cat)))
		   (progn
		     (setcdr (assoc "primary" cat) (mt-cat-toggle (cdr (assoc "primary" cat))))
		     (setcdr (assoc "secondary" cat) nil))
		 (setcdr (assoc "primary" cat) nil))
	       t))
   mt-cat-col)))

(defun mt-cat-toggle-secondary (pos)
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	(cookie (tin-cookie mt-cat-col tin)))

  (setcdr (assoc "secondary" cookie) (mt-cat-toggle (cdr (assoc "secondary" cookie))))
  (setcdr (assoc "primary" cookie) nil)
  (collection-refresh mt-cat-col)
  (goto-char pos))) ; lazy, but why test?


(defun mt-cat-toggle (bool)
  (if bool
      nil
    t))

(defun mt-cat-update ()
  "Sets the category information on the post on the server"
  (interactive)
  (mt-set-post-categories (mt-cat-post-id) (mt-cats-as-array))
  (bury-buffer)
  (delete-window))

(defun mt-cat-post-id ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^Post \\([0-9]*\\).*" nil t)
	(match-string 1))))

(defun mt-cats-as-array ()
  (interactive)
  (mt-cat-get-struct (append (get-primary-cat) (get-secondary-cats))))

(defun mt-cat-get-struct (cats)
  (mapcar 
   (lambda (cat)
     (list (cons "categoryId" (cdr (assoc "cat-id" cat)))))
   cats))
  
(defun get-primary-cat ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-primary-p)))

(defun get-secondary-cats ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-secondary-p)))

(defun is-marked-primary-p (cat)
  (if (cdr (assoc "primary" cat))
      t
    nil))

(defun is-marked-secondary-p (cat)
  (if (cdr (assoc "secondary" cat))
      t
    nil))
  
(defun mt-cat-pp (mt-cat-info)
  "pretty printer for cookie collection"
  (insert "[")
  (cond 
   ((cat-info-primary-p mt-cat-info)
    (insert "+"))
   ((cat-info-secondary-p mt-cat-info)
    (insert "-"))
   (t (insert " ")))
  (insert (concat (cdr (assoc "cat-id" mt-cat-info)) " ]"))
  (insert " ")
  (insert (cdr (assoc "cat-name" mt-cat-info))))

(defun cat-info-primary-p (mt-cat-info)
  (if (cdr (assoc "primary" mt-cat-info))
      t
    nil))

(defun cat-info-secondary-p (mt-cat-info)
  (if (cdr (assoc "secondary" mt-cat-info))
      t
    nil))

(provide 'mt)

;;; mt.el ends here

--=-=-=


-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org

--=-=-=--


From mt-el@marginalia.org  Wed Oct 23 05:57:17 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Tue, 22 Oct 2002 21:57:17 -0700
Subject: [mt-el] more code to bang on
Message-ID: <87lm4plple.fsf@telus.net>

--=-=-=

Hey all,

I reworked a couple things, added a few functions. You know how it
goes.

Changes:

Instead of attempting to display commenting/trackback status in the
modeline, I've made the post buffer more like a mail message, with a
headers-type section.

Added weblog-add-extended and weblog-add-excerpt functions which,
surprisingly, allow you to add extended and excerpt sections. You
should get errors if you try to add a section and you already have
one. I debated making the function go to the existing section, but
didn't. Counter-arguments for doing this listened to.

Somehow I ended up with two chunks of code that did the insertion of a
post into a buffer, that has been fixed. Also renamed
create-post-buffer to weblog-create-post-buffer.

Still todo:

Add the ability to switch comment/ping setting within a post buffer. I
think I might need to rethink how I've set this up to make it happen,
but I'll see.

Font lock to better demarcate the sections in the post buffer.

Anything else?


--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=mt.el
Content-Transfer-Encoding: 8bit

;; mt.el - Elisp package for posting to an MT blog via XML-RPC
;; $Id: mt.el,v 1.22 2002/10/23 04:15:50 was Exp $

;; Copyright (C) 2002 Bill Stilwell

;; Author: Bill Stilwell <bill@marginalia.org>
;; Version: 0.99
;; Created: August 7 2002
;; 
;; This file is NOT (yet) part of GNU Emacs.

;; This 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, or (at your option)
;; any later version.

;; this software 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; This packages enables you to create new posts and edit old posts on
;; your Movable Type Weblog. It may be expanded so that any weblog
;; tool that supports the metaWeblog API can be used.

;;; THANKS & CREDIT:
;; mt.el is based heavily on the blogger.el package by Mark
;; A. Hershberger (http://mah.everybody.org/hacks/emacs/blogger.el.txt)
;; and Jamie Zawinski's LiveJournal package
;; (http://www.jwz.org/hacks/jwz-lj.el). All the good parts here are
;; probably from them; the parts that screw up are mine.


;;; INSTALLATION:
;;
;; To install, put mt.el somewhere in your load path:
;; e.g.: (add-to-list 'load-path "~/elisp")

;; and add these lines to your .emacs or ~/.xemacs/init.el:
;; (require 'mt)
;; (global-set-key "\C-cwc" 'weblog-create-post)
;; (global-set-key "\C-cwr" 'weblog-retrieve-recent-posts)
;; (global-set-key "\C-cwg" 'weblog-retrieve-post)
;;
;; This will load mt.el and bind C-c w c to the post creation command.
;;
;; You will also need to set a few variables, either in your .emacs or
;; via the customization system.

;; With customize:

;; Type M-x customize-group <RET> weblog <RET>. You will need to set:
;;
;; Id - This is the id of your weblog. You can get this from the query
;; string when you go into the movable type main menu for your
;; weblog. You should have something like:
;; 'mt.cgi?__mode=menu&blog_id=1'. In this example, the Id would be 1.
;;
;; Username - username
;;
;; Password - password
;;
;; Url - complete URL to access the mt xmlrpc service. This is likely
;; to be something like:
;; http://www.example.com/PATH/TO/MT/mt-xmlrpc.cgi
;;
;; You can also set Post Count to something other than the
;; default. This value is used when no count is provided to the
;; retrieve recent posts command.
;;
;; If you wish, you can set these values directly in your .emacs:
;; (setq weblog-id "1")
;; (setq weblog-username "My Username")
;; (setq weblog-password "easy")
;; (setq weblog-url "http://www.example.com/mt/mt-xmlrpc.cgi")
;; (setq weblog-post-count 5)
;; (setq weblog-publish-on-save t)
;;
;;; USING mt.el
;; C-c w c -- create a new buffer for a new post

;; C-c w r -- retrieve a set of recent posts. If a prefix argument is
;;            supplied (e.g. C-u 3 C-c w r), that number of posts will
;;            be fetched; otherwise the value of weblog-post-count is
;;            used. A new buffer will open with a list of posts, hit
;;            return on any of the posts to edit that post.

;; C-c w g -- get a particular post. You will be prompted for the post
;;            id.

;; C-c C-c -- save it! Will publish if weblog-publish-on-save is
;;            true.

;; C-c C-s -- save without publish, regardless of
;;            weblog-publish-on-save setting.

;; C-c C-p -- save and publish, regardless weblog-publish-on-save setting.

;; C-c C-e -- in post list, edit post at point

;; C-c C-r -- refresh current post buffer

;;; Requirements:

;; requires xml-rpc.el 
;; http://www.marginalia.org/code/xml-rpc.el
;; http://elisp.info/package/xml-rpc/xml-rpc.el
;; and xml.el
;; ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el

;; elib is required (http://www.gnu.org/software/elib/elib.html)

;; if you're using emacs, you may need to put (require 'cl) in your
;; .emacs (thanks to Shawn Ledbetter for pointing this out).

;; mt.el uses the metaweblog API (see http://www.xmlrpc.com/metaWeblogApi
;; and movabletype's support for it:
;; http://www.movabletype.org/docs/mtmanual_programmatic.html#xmlrpc%20api.
;;
;; If your weblog does not support these tools, this package will NOT
;; work. To see if your movable type weblog can use XML-RPC, load
;; mt-check.cgi. If you see the following lines, you should be ok:
;;    LWP::UserAgent...
;;        Your server has LWP::UserAgent installed.

;;    SOAP::Lite...
;;        Your server has SOAP::Lite installed.
;; 
;; If not, you will have to install them; see MT's installation manual
;; for instructions.
;;
;; There are currently issues with line breaks. If you set up MT to
;; automatically convert linebreaks and you have auto-fill on in your
;; entry buffer (or fill before submitting), you will end up breaking
;; entries where auto fill wraps tags in the middle. My current
;; recommendation is to turn this off in your MT preferences and have
;; mt.el wrap your paragraphs in <p> tags. However, if you really
;; don't like this, turn off weblog-wrap-paras in customize

;; The publish flag

;; The default behaviour for MT's XML-RPC API is to always set a
;; post's status to Publish. From comments in XMLRPCServer.pm:

;; ## In 2.1 we changed the behavior of the $publish flag. Previously, 
;; ## it was used to determine the post status. That was a bad idea. 
;; ## So now entries added through XML-RPC are always set to publish, 
;; ## unless the user has set "NoPublishMeansDraft 1" in mt.cfg, which 
;; ## enables the old behavior. 

;; So the _default_ behaviour when setting publish to nil (either in
;; your configuration settings or with an explicit
;; weblog-submit-no-publish) is to create or save a post with a status
;; of publish but no site rebuild. If you change the setting in your
;; mt.cfg, the same action will set the status accordingly.

;; TODO 

;; BUGS

;; Paragraph wrapping breaks on the last paragraph if there isn't a
;; newline at the end. Current hack fix is to add newline at the end.

;;; CODE

(require 'xml-rpc)

(defgroup weblog nil
  "Emacs interface to the metaWeblogAPI."
  :group 'emacs)

(defcustom weblog-id nil
  "Id for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-username nil
  "Username for this weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-password nil
  "Password for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-url nil
  "Complete url to your XMLRPC service."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-count 5
  "Default number of posts to retrieve if no count supplied."
  :group 'weblog
  :type 'integer)

(defcustom weblog-publish-on-save t
  "If t, publish on save."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-wrap-paras t
  "If t, mt.el will wrap paragraphs in <p> tags, and you should turn this
  functionality off in MT. If nil, no wrapping will be done, but you
  should turn off auto-fill in your post buffers."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-local-save-dir "~/.mt"
  "Used to cache weblog name and local copies of posts"
  :group 'weblog
  :type 'directory)

(defcustom weblog-auto-categories 0
  "If t, mt will automatically prompt you to set categories on new posts."
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-comments 1
  "Default value for the allow-comments field. Can be Yes, No, or Ask"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-pings 1
  "Default value for the allow-pings field. If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-convert-breaks 0
  "Should MT convert line breaks? If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-post-marker "--post follows this line--\n"
  "String to demarcate title and post."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-post-marker "--end of post--\n"
  "String to mark end of main post body."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-extended 0
  "Add an extended entry section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-extended-marker "--extended entry follows this line--\n"
  "String to mark beginning of extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-extended-marker "--end of extended--\n"
  "String to mark end of an extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-excerpt 0
  "Add an excerpt section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-excerpt-marker "--excerpt follows this line--\n"
  "String to mark beginning of excerpt."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-excerpt-marker "--end of excerpt--\n"
  "String to mark end of excerpt."
  :group 'weblog
  :group 'string)


(defvar mt-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-mode-map))
    (define-key map "\C-c\C-c" 'weblog-submit-post)
    (define-key map "\C-c\C-s" 'weblog-submit-publish)
    (define-key map "\C-c\C-p" 'weblog-submit-no-publish)
    (define-key map "\C-c\C-e" 'weblog-edit-post-at-point)
    (define-key map "\C-c\C-r" 'weblog-refresh-buffer)
    (define-key map "\C-c\C-d" 'mt-cat-create-buffer)
    map))

(defvar mt-cat-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-cat-mode-map))
    (suppress-keymap map)
    (define-key map "p" 'mt-cat-toggle-primary)
    (define-key map "s" 'mt-cat-toggle-secondary)
    (define-key map "\C-c\C-c" 'mt-cat-update)
    map))

(defvar weblog-mode-hook nil
  "Hook run after starting up weblog mode.")

(defvar weblog-new-post-hook nil
  "Hook to run when visiting a new post buffer")

(defun weblog-mode ()
  "Major mode for editing posts for a weblog."
  (interactive)
  (text-mode)
  (use-local-map mt-mode-map)
  (setq mode-name "weblog")
  (setq major-mode 'weblog-mode)
  ;; what would be nice for hooks is to have it prompt for
  ;; title/category or not depending on user preference
  (run-hooks 'weblog-mode-hook))

(defun weblog-cat-mode ()
  "Major mode for editing categories on a post."
  (interactive)
  (text-mode)
  (use-local-map mt-cat-mode-map)
  (setq mode-name "weblog-cat")
  (setq major-mode 'weblog-cat-mode)
  (setq buffer-read-only t))

(defun weblog-create-post ()
  "*Compose a weblog post."
  (interactive)
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Title: \n")
  (insert "Comments: ")
  (cond 
   ((= weblog-allow-comments 1)
    (insert "Yes"))
   ((= weblog-allow-comments 2)
    (insert "Ask"))
   ((= weblog-allow-comments 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")  
  (insert "Pings: ")
  (cond 
   ((= weblog-allow-pings 1)
    (insert "Yes"))
   ((= weblog-allow-pings 2)
    (insert "Ask"))
   ((= weblog-allow-pings 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")
  (insert "Convert line breaks: ")
  (cond 
   ((= weblog-convert-breaks 1)
    (insert "Yes"))
   ((= weblog-convert-breaks 2)
    (insert "Ask"))
   ((= weblog-convert-breaks 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")

  (insert weblog-begin-post-marker)
  (insert "\n\n")
  (insert weblog-end-post-marker)
  (if (> (weblog-add-extended-p) 0)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker)))
  (if (> (weblog-add-excerpt-p) 0)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker)))
  (beginning-of-buffer)
  (end-of-line)
  (weblog-mode)
  (run-hooks 'weblog-new-post-hook))

(defun weblog-submit-post (&optional publish)
  "*Publish current message."
  (interactive)
  (setq new-post (new-postp))
  (weblog-refresh-buffer
  (if new-post
      (mwa-new-post publish)
    (mwa-edit-post publish)))
  (if new-post
      (if (weblog-auto-categories-p)
	  (mt-cat-create-buffer))))

(defun weblog-retrieve-post (&optional post-id)
  "*Retrieves a post for a given weblog post id."
  (interactive)
  (weblog-create-post-buffer 
   (mwa-get-post (or post-id (read-from-minibuffer "Post Id: ")))))

(defun weblog-retrieve-recent-posts (&optional num)
  "*Retrieve a list of recent posts, puts in a buffer for further editing."
  (interactive "P")
  (create-posts-buffer (mwa-get-recent-posts (or num weblog-post-count))))

(defun weblog-edit-post-at-point ()
  "Edit the post at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(weblog-create-post-buffer (mwa-get-post (match-string 1)))
      (error "Couldn't determine post number"))))

(defun weblog-submit-publish ()
  "Save and publish post regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '1))

(defun weblog-submit-no-publish ()
  "Save without publish regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '0))

(defun weblog-switch-weblog (&optional id)
  "Convenient way to switch what weblog is posted to"
  (interactive)
  (setq weblog-id (or id (read-from-minibuffer "Blog Id: ")))
  (setq weblog-name (mt-get-weblog-name weblog-id)))

(defun weblog-auto-categories-p ()
  "Returns t if a categories buffer should be setup."
  (if (> weblog-auto-categories 1)
      (if (y-or-n-p "Set categories on this post? ")
	  t
	nil)
    (if (= weblog-auto-categories 1)
	t
      nil)))

(defun weblog-allow-comments-p ()
  "Returns t if comments should be allowed for this post."
  (if (> weblog-allow-comments 1)
      (if (y-or-n-p "Allow comments on this post? ")
	  '1
	'0)
    weblog-allow-comments))

(defun weblog-allow-pings-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-allow-pings 1)
      (if (y-or-n-p "Allow pings on this post? ")
	  '1
	'0)
    weblog-allow-pings))

(defun weblog-convert-breaks-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-convert-breaks 1)
      (if (y-or-n-p "Convert line breaks on this post? ")
	  '1
	'0)
    weblog-convert-breaks))

(defun weblog-go-to-body ()
  "Moves point to beginning of post body."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-post-marker))

(defun weblog-add-excerpt ()
  "Add an excerpt section, if one doesn't exist."
  (interactive)
  (save-excursion
    (if (weblog-go-to-excerpt)
	(error "An excerpt section already exists.")
      (search-forward weblog-end-post-marker)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker))))
  (weblog-go-to-excerpt))

(defun weblog-go-to-excerpt ()
  "Moves point to beginning of excerpt."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-excerpt-marker nil t))

(defun weblog-add-extended ()
  "Add an extended section, if one doesn't exist."
  (interactive)
  (save-excursion
    (if (weblog-go-to-extended)
	(error "An excerpt section already exists.")
      (search-forward weblog-end-post-marker)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker))))
  (weblog-go-to-extended))

(defun weblog-go-to-extended ()
  "Moves point to beginning of extended entry."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-extended-marker nil t))

(defun weblog-add-excerpt-p ()
  "Return t if a block for an excerpt should be added to this post."
  (if (> weblog-post-buffer-excerpt 1)
      (if (y-or-n-p "Add an excerpt block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-excerpt))

(defun weblog-add-extended-p ()
  "Return t if a block for an extended entry should be added to this post."
  (if (> weblog-post-buffer-extended 1)
      (if (y-or-n-p "Add an extended entry block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-extended))

(defun create-posts-buffer (posts)
  "Creates a listing of retrieved posts"
  ; Needs to add a key binding for return to edit a post maybe
  (switch-to-buffer (generate-new-buffer "*weblog-posts*"))
  (insert "Recent posts:\n\n")
  (mapcar 
   (lambda (post)
     (setq post-id (cdr (assoc "postid" post)))
     (setq post-title (cdr (assoc "title" post)))
     (setq post-body (cdr (assoc "description" post)))
     (insert post-id)
     (insert " ")
     (insert post-title)
     (insert "\n"))
   posts)
  (weblog-mode)
  (goto-char (point-min)))
	  
(defun weblog-create-post-buffer (post)
  "Creates buffer filled with post info"
  ;; so we should have a struct in post
  (setq post-id (cdr (assoc "postid" post)))
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name post-id )))
  (erase-buffer)
  (goto-char (point-min))
  (weblog-insert-post-contents post)
  (weblog-go-to-body)
  (end-of-line)
  (weblog-mode))

(defun get-post-buffer-name (&optional post-id)
  (setq log-name (mt-get-weblog-name weblog-id))
  (if post-id
      (concat "*post " post-id " (" log-name ")*") ; need to check if numberp?
    (concat "*post (" log-name ")*"))) ; stupid 

;; metaweblogapi implementations
(defun mwa-new-post (&optional publish)
  "Makes a new post via metaWeblogAPI newPost command"
  (xml-rpc-method-call 
   weblog-url 
   'metaWeblog.newPost 
   weblog-id 
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-edit-post (&optional publish)
  "Edits a post via metaWeblogAPI editPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.editPost
   (weblog-post-id)
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-get-post (post-id)
  "Gets a single post via metaWeblogAPI getPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getPost
   post-id
   weblog-username
   weblog-password))

(defun mwa-get-recent-posts (number-of-posts)
  "Gets specified number of recent posts via metaWeblogAPI getRecentPosts command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getRecentPosts
   weblog-id
   weblog-username
   weblog-password
   number-of-posts))

;; MovableType XMLRPC implementation - category stuff

(defun mt-get-category-list ()
  "Gets list of categories for a weblog via mt API getCategoryList command"
  (xml-rpc-method-call
   weblog-url
   'mt.getCategoryList
   weblog-id
   weblog-username
   weblog-password))

(defun mt-get-post-categories (&optional post-id)
  "Gets categories for a post via mt API getPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.getPostCategories
   (or post-id (weblog-post-id))
   weblog-username
   weblog-password))

(defun mt-set-post-categories (post-id post-categories)
  "Sets categories for a post via mt API setPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.setPostCategories
   post-id
   weblog-username
   weblog-password
   post-categories))

(defun mt-get-trackback-pings ()
  "Retrieves trackback pings for an entry, if any."
  (xml-rpc-method-call
   weblog-url
   'mt.getTrackbackPings
   (weblog-post-id)))

(defun mt-publish-post (&optional post-id)
  "Rebuild the static files related to an entry."
  (xml-rpc-method-call
   weblog-url
   'mt.publishPost
   (or post-id (weblog-post-id))))

;; blogger api implementation
(defun blogger-get-users-blogs ()
  "Retrieves info about current users blogs"
  (xml-rpc-method-call
   weblog-url
   'blogger.getUsersBlogs
   '""
   weblog-username
   weblog-password))

;; support utility functions
(defun weblog-post-title ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Title:[ \t]*\\(.*\\)$" nil t)
	  (setq post-title (match-string 1))
	(read-from-minibuffer "Post Title: " post-title))
      (xml-rpc-encode post-title))))

(defun weblog-post-body ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-post-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-post-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	nil))))

(defun weblog-post-excerpt ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-excerpt-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-excerpt-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun weblog-post-extended ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-extended-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-extended-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun xml-rpc-encode (string)
  "Replaces < with &lt; and & with &amp;"
  (let (buf)
    (save-excursion
      (unwind-protect
	  (progn
	    (setq buf (get-buffer-create " *xml-rpc-escape*"))
	    (set-buffer buf)
	    (erase-buffer)
	    (insert-string string)
	    
	    ;; This whole section is a massive massive hack
	    (goto-char (point-min))
	    (while (re-search-forward "&" nil t)
	      (replace-match "&amp;" nil nil)) ;; can't have bare &
	    (goto-char (point-min))
	    (while (re-search-forward "<" nil t)
	      (replace-match "&lt;" nil nil))  ;; can't have bare <
	    (buffer-string))
	(if buf (kill-buffer buf))))))

(defun wrap-paragraphs (string)
    (save-excursion
      (unwind-protect
	  (progn
	    (with-temp-buffer
	      (insert-string string)
	      (goto-char (point-min))
	      ;; only try and wrap if there's something non-empty to wrap
	      (if (re-search-forward "[^ \n\t\r]" nil t)
		  (progn
		    (goto-char (point-max))
		    ;; blecherous hack here
		    (while (mt-looking-back-at "\n")
		      (delete-backward-char 1))
		    (insert "\n")
		    (goto-char (point-min))
		    (while (not (eq (point) (point-max)))
		      (start-of-paragraph-text)
		      (if (not (looking-at "<p>"))  
			  (insert "<p>")) 
		      (end-of-paragraph-text) 
		      (if (not (mt-looking-back-at "</p>"))  
			  (insert "</p>"))
		      (end-of-paragraph-text))))
		    (buffer-string))))))
  

(defun weblog-post-id ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Post Id:[ \t]*\\([0-9]*\\).*$" nil t)
	  (setq post-id (match-string 1))
	(setq post-id nil)))))

(defun weblog-insert-post-contents (post)
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (setq post-comments-allowed (cdr (assoc "mt_allow_comments" post)))
  (setq post-pings-allowed (cdr (assoc "mt_allow_pings" post)))
  (setq post-convert-breaks (cdr (assoc "mt_convert_breaks" post)))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert "Comments: ")
  (if post-comments-allowed
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert "Pings: ")
  (if post-pings-allowed
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert "Convert line breaks: ")
  (if post-convert-breaks
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert post-body)
  (insert "\n")
  (insert weblog-end-post-marker)
  (if (and (not (string= post-extended "")) post-extended)
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if (and (not (string= post-excerpt "")) post-excerpt)
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker))))

(defun weblog-refresh-buffer (&optional post-id)
  "Refreshes content of current buffer with whatever mt server has."
  (interactive)
  (setq pm (point-max))
  (goto-char (point-max))
  (if (stringp post-id)
      (setq id post-id)
    (setq id (weblog-post-id)))
  (weblog-insert-post-contents
   (mwa-get-post id))
  (delete-region (point-min) pm)
  (weblog-go-to-body))

(defun new-postp ()
  "Return t if buffer is a new post."
  (not (weblog-post-id)))

(defun publishp ()
  "Return 1 if publish, 0 otherwise."
  (if weblog-publish-on-save
      (setq publish '1)
    (setq publish '0)))

(defun mt-looking-back-at (regexp &optional bound)
  "Return t if text before point matches REGEXP.
Modifies the match data. If supplied, BOUND means not to look farther
back that that many characters before point. Otherwise, it defaults to
\(length REGEXP), which is good enough when REGEXP is a simple
string."
  ;; taken from mmm-mode - mmm-utils.el
  (eq (point)
      (save-excursion
        (and (re-search-backward regexp
               (- (point) (or bound (length regexp)))
               t)
             (match-end 0)))))

(defun mt-clean-body (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward "&#xd;" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-get-weblog-name (&optional log-id)
  "retrieves name of a weblog given an id, either from local file or net"
  (if (mt-weblog-file-exists-p (or log-id weblog-id))
      (mt-read-weblog-name (or log-id weblog-id))
    (mt-store-weblog-name (mt-fetch-weblog-name (or log-id weblog-id)))))

(defun mt-weblog-file-exists-p (log-id)
  "Tests to see if the weblog name file exists"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (file-exists-p weblog-file-name))

(defun mt-read-weblog-name (log-id)
  "Reads the weblog name from a file"
  (with-temp-buffer
    (insert-file-contents (concat weblog-local-save-dir "/" "weblog." log-id))
    (goto-char (point-min))
    (while (re-search-forward "\n" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-store-weblog-name (weblog-name)
  "Stores the weblog name in a file"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (if (not (file-directory-p weblog-local-save-dir))
      (make-directory weblog-local-save-dir))
  (with-temp-buffer
    (insert weblog-name)
    (insert "\n")
    (append-to-file (point-min) (point-max) weblog-file-name))
  weblog-name)

(defun mt-fetch-weblog-name (log-id)
  "Fetches weblog name from server using XML-RPC"
  (setq weblog-name nil)
  (mapc
   (lambda (log-info)
     (if (string= (or log-id weblog-id) (cdr (assoc "blogid" log-info)))
	 (setq weblog-name (cdr (assoc "blogName" log-info)))))
   (blogger-get-users-blogs))
  weblog-name)


;; category handling stuff

;; Here's the basics of what I'd like to do:
;; - have a buffer created (probably split the window) that gives the
;;   categories available
;; - allow user to mark primary and secondary categories. Only one
;;   primary category is allowed, as many secondary as necessary.
;; - an update command that sets the categories on a post.
(require 'cookie)

(defvar mt-cat-col nil)

(defvar mt-cat-buf "*Category Selection*")

(defun mt-cat-create-buffer (&optional post-id)
  "Creates a buffer filled with categories."
  (interactive)
  (setq post-id (or post-id (or (weblog-get-post-id-at-point) (weblog-post-id))))
  (split-window)
  (save-excursion
    (set-buffer (get-buffer-create mt-cat-buf))
    (setq buffer-read-only nil)
    (erase-buffer))
  (setq mt-cat-col (mt-cat-create-cookie-collection post-id))
  (mt-cat-enter-cookies post-id (mt-get-post-categories post-id))
  (other-window 1)
  (switch-to-buffer mt-cat-buf)
  
  (weblog-cat-mode))

(defun weblog-get-post-id-at-point ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(match-string 1))))


(defun mt-cat-create-cookie-collection (post-id)
  (collection-create
   mt-cat-buf
  (function mt-cat-pp)
  (concat "Post " post-id " category selection\n") 
  "\n+ Primary category\n- Secondary category" 0))

(defun mt-cat-enter-cookies (post-id post-categories)
  (collection-append-cookies 
   mt-cat-col
   (mapcar 
    (lambda (category)
      (setq cat-id 
	    (cdr (assoc "categoryId" category)))
      (setq cat-primary 
	    (mt-post-primary post-categories))
      (setq cat-secondary 
	    (mt-post-secondary post-categories))
      (list (cons "cat-id" cat-id)
	    (cons "cat-name" 
		  (cdr (assoc "categoryName" category)))
	    (cons "primary" 
		  (is-primary-p cat-id cat-primary))
	    (cons "secondary" 
		  (is-secondary-p cat-id cat-secondary))))
    (mt-get-category-list))))

(defun is-primary-p (cat-id cat-primary)
  (if (string= cat-id cat-primary)
      t
    nil))

(defun is-secondary-p (cat-id cat-secondary)
  (if (member cat-id cat-secondary)
      t
    nil))

(defun mt-post-primary (post-categories)
  "Returns the category id of the primary category for a post"
  ;; this is a bit hackish and inefficient, as we'll continue looping
  ;; over the list of categories even after we've got our primary
  (let (primary)
    (mapc
     (lambda (category)
       (if (cdr (assoc "isPrimary" category))
	   (setq primary (cdr (assoc "categoryId" category)))))
     post-categories)
    primary))
       
(defun mt-post-secondary (post-categories)
  "Returns a list of the category id(s) of the secondary categories
  for a post"
  (interactive)
  (mapcar
   (lambda (category)
     (if (not (cdr (assoc "isPrimary" category)))
	 (cdr (assoc "categoryId" category))
       nil))
   post-categories))

(defun mt-cat-get-tin (pos)
  (interactive "d")
  (mt-cat-mark-primary cookie))

(defun mt-cat-toggle-primary (pos)
  "toggles primary setting of this category"
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	 (cookie (tin-cookie mt-cat-col tin)))
  (cookie-map
   (function (lambda (cat)
	       ;; if this is our primary cat, toggle it
	       ;; othewise, mark the primary field nil
	       ;; this should enforce only one primary cat at a time,
	       ;; also sets secondary to nil
	       (if (string= (cdr (assoc "cat-id" cookie)) (cdr (assoc "cat-id" cat)))
		   (progn
		     (setcdr (assoc "primary" cat) (mt-cat-toggle (cdr (assoc "primary" cat))))
		     (setcdr (assoc "secondary" cat) nil))
		 (setcdr (assoc "primary" cat) nil))
	       t))
   mt-cat-col)))

(defun mt-cat-toggle-secondary (pos)
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	(cookie (tin-cookie mt-cat-col tin)))

  (setcdr (assoc "secondary" cookie) (mt-cat-toggle (cdr (assoc "secondary" cookie))))
  (setcdr (assoc "primary" cookie) nil)
  (collection-refresh mt-cat-col)
  (goto-char pos))) ; lazy, but why test?


(defun mt-cat-toggle (bool)
  (if bool
      nil
    t))

(defun mt-cat-update ()
  "Sets the category information on the post on the server"
  (interactive)
  (mt-set-post-categories (mt-cat-post-id) (mt-cats-as-array))
  (bury-buffer)
  (delete-window))

(defun mt-cat-post-id ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^Post \\([0-9]*\\).*" nil t)
	(match-string 1))))

(defun mt-cats-as-array ()
  (interactive)
  (mt-cat-get-struct (append (get-primary-cat) (get-secondary-cats))))

(defun mt-cat-get-struct (cats)
  (mapcar 
   (lambda (cat)
     (list (cons "categoryId" (cdr (assoc "cat-id" cat)))))
   cats))
  
(defun get-primary-cat ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-primary-p)))

(defun get-secondary-cats ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-secondary-p)))

(defun is-marked-primary-p (cat)
  (if (cdr (assoc "primary" cat))
      t
    nil))

(defun is-marked-secondary-p (cat)
  (if (cdr (assoc "secondary" cat))
      t
    nil))
  
(defun mt-cat-pp (mt-cat-info)
  "pretty printer for cookie collection"
  (insert "[")
  (cond 
   ((cat-info-primary-p mt-cat-info)
    (insert "+"))
   ((cat-info-secondary-p mt-cat-info)
    (insert "-"))
   (t (insert " ")))
  (insert (concat (cdr (assoc "cat-id" mt-cat-info)) " ]"))
  (insert " ")
  (insert (cdr (assoc "cat-name" mt-cat-info))))

(defun cat-info-primary-p (mt-cat-info)
  (if (cdr (assoc "primary" mt-cat-info))
      t
    nil))

(defun cat-info-secondary-p (mt-cat-info)
  (if (cdr (assoc "secondary" mt-cat-info))
      t
    nil))

(provide 'mt)

;;; mt.el ends here

--=-=-=


-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org

--=-=-=--


From mt-el@marginalia.org  Thu Oct 24 06:00:49 2002
From: mt-el@marginalia.org (Jack Moffitt)
Date: Wed, 23 Oct 2002 23:00:49 -0600
Subject: [mt-el] more code to bang on
In-Reply-To: <87lm4plple.fsf@telus.net>
References: <87lm4plple.fsf@telus.net>
Message-ID: <20021024050049.GL22950@i.cantcode.com>

> Instead of attempting to display commenting/trackback status in the
> modeline, I've made the post buffer more like a mail message, with a
> headers-type section.

This is much nicer.

> Font lock to better demarcate the sections in the post buffer.

What should I see with this?  I noticed nothing different font or
colorwise, but it's possible that I completely misunderstand what
font lock is :)


I did run into one small problem.  I started typing like so:

-- post begins blah --
Hello, my name is jack.
-- post ends blah --

And I hit M-q to fill, and it filled everything, including all the
headers.  I put everything back to normal but then was not able to save
the post.  I kept getting various errors like my title not being a list
or something.  In the future I'll remember to leave a blank line, but it
seemed weird that I couldn't fix the headers.

Saving to a text file surprisingly took me out of weblog-mode.  It would
be nice if I could do this without leaving the mode, but perhaps the
intent is for me to save with C-c C-c and suck it down if I need to
edit.  In the end, I had to save to a text file, create a new post, import 
the file, and then it worked.

It's looking better with each version, though :)

jack.

From mt-el@marginalia.org  Thu Oct 24 06:46:22 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Wed, 23 Oct 2002 22:46:22 -0700
Subject: [mt-el] more code to bang on
In-Reply-To: <20021024050049.GL22950@i.cantcode.com> (Jack Moffitt's message
 of "Wed, 23 Oct 2002 23:00:49 -0600")
References: <87lm4plple.fsf@telus.net> <20021024050049.GL22950@i.cantcode.com>
Message-ID: <87elagl781.fsf@telus.net>

Jack Moffitt <jack@xiph.org> writes:

>> Instead of attempting to display commenting/trackback status in the
>> modeline, I've made the post buffer more like a mail message, with a
>> headers-type section.
>
> This is much nicer.

Cool.

>> Font lock to better demarcate the sections in the post buffer.
>
> What should I see with this?  I noticed nothing different font or
> colorwise, but it's possible that I completely misunderstand what
> font lock is :)

Well, once I've implented it, hopefully you'll notice something. That
was part of the todo list. :-)

> I did run into one small problem.  I started typing like so:
>
> -- post begins blah --
> Hello, my name is jack.
> -- post ends blah --
>
> And I hit M-q to fill, and it filled everything, including all the
> headers.  I put everything back to normal but then was not able to save
> the post.  I kept getting various errors like my title not being a list
> or something.  In the future I'll remember to leave a blank line, but it
> seemed weird that I couldn't fix the headers.

Hrm. Hadn't thought about that issue, but it is a good one. There must
be a way to override fill. The headers thing is weird, it might be
that a space got left out from where it REALLY NEEDED one.

> Saving to a text file surprisingly took me out of weblog-mode.  It would
> be nice if I could do this without leaving the mode, but perhaps the
> intent is for me to save with C-c C-c and suck it down if I need to
> edit.  In the end, I had to save to a text file, create a new post, import 
> the file, and then it worked.

Hmm. Well, my intention is to at some point (post this next release,
probably) cache articles to disk. Then you could save locally and
remotely, and it would function as some sort of backup. I'll see if I
can fix the immediate problem though!

-b
-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org


From mt-el@marginalia.org  Thu Oct 24 07:03:18 2002
From: mt-el@marginalia.org (Andrew J Cosgriff)
Date: Thu, 24 Oct 2002 16:03:18 +1000
Subject: [mt-el] more code to bang on
In-Reply-To: <87elagl781.fsf@telus.net> (Bill Stilwell's message of "Wed, 23
 Oct 2002 22:46:22 -0700")
References: <87lm4plple.fsf@telus.net> <20021024050049.GL22950@i.cantcode.com>
 <87elagl781.fsf@telus.net>
Message-ID: <1y7kg84bmh.fsf@earthling.aia.aig.com.au>

Bill Stilwell wrote :

>>> Font lock to better demarcate the sections in the post buffer.
>>
>> What should I see with this?  I noticed nothing different font or
>> colorwise, but it's possible that I completely misunderstand what
>> font lock is :)

message-font-lock-keywords is about half the work done for you already
:)

-- 
Andrew J Cosgriff <ajc@polydistortion.net>
polaroid dwarf cunning x moodswing

From mt-el@marginalia.org  Thu Oct 24 07:05:22 2002
From: mt-el@marginalia.org (Jack Moffitt)
Date: Thu, 24 Oct 2002 00:05:22 -0600
Subject: [mt-el] more code to bang on
In-Reply-To: <87elagl781.fsf@telus.net>
References: <87lm4plple.fsf@telus.net> <20021024050049.GL22950@i.cantcode.com> <87elagl781.fsf@telus.net>
Message-ID: <20021024060522.GO22950@i.cantcode.com>

> > What should I see with this?  I noticed nothing different font or
> > colorwise, but it's possible that I completely misunderstand what
> > font lock is :)
> 
> Well, once I've implented it, hopefully you'll notice something. That
> was part of the todo list. :-)

*sigh*.   Now I feel like an idiot :)

> Hrm. Hadn't thought about that issue, but it is a good one. There must
> be a way to override fill. The headers thing is weird, it might be
> that a space got left out from where it REALLY NEEDED one.

I removed spaces from the end of the lines (the "-- post begins blah --"
doesn't tolerate trailing whitespace, which I suppose is not really a
bug) so every line was like:  Title:[ ]blah\n where [ ] is a single
space.  Can you reproduce this, or should I try and come up with an
exact sequence? :)  I notice from your mail headers that you use xemacs,
so maybe this is GNU emacs specific.

> Hmm. Well, my intention is to at some point (post this next release,
> probably) cache articles to disk. Then you could save locally and
> remotely, and it would function as some sort of backup. I'll see if I
> can fix the immediate problem though!

Actually, I'd like the caching to disk feature.  Maybe blogid.postid.txt
in the same directory the other cached information goes in.

jack.

From mt-el@marginalia.org  Thu Oct 24 07:19:17 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Wed, 23 Oct 2002 23:19:17 -0700
Subject: [mt-el] more code to bang on
In-Reply-To: <20021024060522.GO22950@i.cantcode.com> (Jack Moffitt's message
 of "Thu, 24 Oct 2002 00:05:22 -0600")
References: <87lm4plple.fsf@telus.net> <20021024050049.GL22950@i.cantcode.com>
 <87elagl781.fsf@telus.net> <20021024060522.GO22950@i.cantcode.com>
Message-ID: <87adl4l5p6.fsf@telus.net>

Jack Moffitt <jack@xiph.org> writes:

>> Hrm. Hadn't thought about that issue, but it is a good one. There must
>> be a way to override fill. The headers thing is weird, it might be
>> that a space got left out from where it REALLY NEEDED one.
>
> I removed spaces from the end of the lines (the "-- post begins blah --"
> doesn't tolerate trailing whitespace, which I suppose is not really a
> bug) so every line was like:  Title:[ ]blah\n where [ ] is a single
> space.  Can you reproduce this, or should I try and come up with an
> exact sequence? :)  I notice from your mail headers that you use xemacs,
> so maybe this is GNU emacs specific.

Nah, I've got both installed, but I'll let you know if I can't
reproduce.

>> Hmm. Well, my intention is to at some point (post this next release,
>> probably) cache articles to disk. Then you could save locally and
>> remotely, and it would function as some sort of backup. I'll see if I
>> can fix the immediate problem though!
>
> Actually, I'd like the caching to disk feature.  Maybe blogid.postid.txt
> in the same directory the other cached information goes in.

Yeah, that's pretty much what it would be. I think it might be cached
in a lisp specific way, just to simplify parsing.

-b
-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org


From mt-el@marginalia.org  Thu Oct 24 07:32:52 2002
From: mt-el@marginalia.org (Andrew J Cosgriff)
Date: Thu, 24 Oct 2002 16:32:52 +1000
Subject: [mt-el] more code to bang on
In-Reply-To: <20021024060522.GO22950@i.cantcode.com> (Jack Moffitt's message
 of "Thu, 24 Oct 2002 00:05:22 -0600")
References: <87lm4plple.fsf@telus.net> <20021024050049.GL22950@i.cantcode.com>
 <87elagl781.fsf@telus.net> <20021024060522.GO22950@i.cantcode.com>
Message-ID: <1y4rbc4a97.fsf@earthling.aia.aig.com.au>

Jack Moffitt wrote :

>> Hrm. Hadn't thought about that issue, but it is a good one. There
>> must be a way to override fill. The headers thing is weird, it
>> might be that a space got left out from where it REALLY NEEDED one.
>
> I removed spaces from the end of the lines (the "-- post begins blah
> --" doesn't tolerate trailing whitespace, which I suppose is not
> really a bug) so every line was like: Title:[ ]blah\n where [ ] is a
> single space.  Can you reproduce this, or should I try and come up
> with an exact sequence? :) I notice from your mail headers that you
> use xemacs, so maybe this is GNU emacs specific.

message.el's message-setup-fill-variables function provides a few
hints on what to do for this - I can probably hack this and font-lock
support in sometime soon if Bill doesn't get to it.

-- 
Andrew J Cosgriff <ajc@polydistortion.net>
robot alone genetics caffeine photocopy

From mt-el@marginalia.org  Sat Oct 26 07:26:21 2002
From: mt-el@marginalia.org (Bill Stilwell)
Date: Fri, 25 Oct 2002 23:26:21 -0700
Subject: [mt-el] font lock
Message-ID: <87iszpk96a.fsf@telus.net>

--=-=-=

Hello all,

Thanks to Andrew's pointer to gnus' font-lock support, I've hacked in
(and I use the term advisedly) font-lock support to mt.el. The code's
attached; nothing else has changed.

It works in xemacs and emacs, and should be customizable in the weblog
group. 

I'm open to suggestions on default colors.

-b


--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=mt.el
Content-Transfer-Encoding: 8bit

;; mt.el - Elisp package for posting to an MT blog via XML-RPC
;; $Id: mt.el,v 1.23 2002/10/26 06:24:02 was Exp $

;; Copyright (C) 2002 Bill Stilwell

;; Author: Bill Stilwell <bill@marginalia.org>
;; Version: 0.99
;; Created: August 7 2002
;; 
;; This file is NOT (yet) part of GNU Emacs.

;; This 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, or (at your option)
;; any later version.

;; this software 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; This packages enables you to create new posts and edit old posts on
;; your Movable Type Weblog. It may be expanded so that any weblog
;; tool that supports the metaWeblog API can be used.

;;; THANKS & CREDIT:
;; mt.el is based heavily on the blogger.el package by Mark
;; A. Hershberger (http://mah.everybody.org/hacks/emacs/blogger.el.txt)
;; and Jamie Zawinski's LiveJournal package
;; (http://www.jwz.org/hacks/jwz-lj.el). All the good parts here are
;; probably from them; the parts that screw up are mine.


;;; INSTALLATION:
;;
;; To install, put mt.el somewhere in your load path:
;; e.g.: (add-to-list 'load-path "~/elisp")

;; and add these lines to your .emacs or ~/.xemacs/init.el:
;; (require 'mt)
;; (global-set-key "\C-cwc" 'weblog-create-post)
;; (global-set-key "\C-cwr" 'weblog-retrieve-recent-posts)
;; (global-set-key "\C-cwg" 'weblog-retrieve-post)
;;
;; This will load mt.el and bind C-c w c to the post creation command.
;;
;; You will also need to set a few variables, either in your .emacs or
;; via the customization system.

;; With customize:

;; Type M-x customize-group <RET> weblog <RET>. You will need to set:
;;
;; Id - This is the id of your weblog. You can get this from the query
;; string when you go into the movable type main menu for your
;; weblog. You should have something like:
;; 'mt.cgi?__mode=menu&blog_id=1'. In this example, the Id would be 1.
;;
;; Username - username
;;
;; Password - password
;;
;; Url - complete URL to access the mt xmlrpc service. This is likely
;; to be something like:
;; http://www.example.com/PATH/TO/MT/mt-xmlrpc.cgi
;;
;; You can also set Post Count to something other than the
;; default. This value is used when no count is provided to the
;; retrieve recent posts command.
;;
;; If you wish, you can set these values directly in your .emacs:
;; (setq weblog-id "1")
;; (setq weblog-username "My Username")
;; (setq weblog-password "easy")
;; (setq weblog-url "http://www.example.com/mt/mt-xmlrpc.cgi")
;; (setq weblog-post-count 5)
;; (setq weblog-publish-on-save t)
;;
;;; USING mt.el
;; C-c w c -- create a new buffer for a new post

;; C-c w r -- retrieve a set of recent posts. If a prefix argument is
;;            supplied (e.g. C-u 3 C-c w r), that number of posts will
;;            be fetched; otherwise the value of weblog-post-count is
;;            used. A new buffer will open with a list of posts, hit
;;            return on any of the posts to edit that post.

;; C-c w g -- get a particular post. You will be prompted for the post
;;            id.

;; C-c C-c -- save it! Will publish if weblog-publish-on-save is
;;            true.

;; C-c C-s -- save without publish, regardless of
;;            weblog-publish-on-save setting.

;; C-c C-p -- save and publish, regardless weblog-publish-on-save setting.

;; C-c C-e -- in post list, edit post at point

;; C-c C-r -- refresh current post buffer

;;; Requirements:

;; requires xml-rpc.el 
;; http://www.marginalia.org/code/xml-rpc.el
;; http://elisp.info/package/xml-rpc/xml-rpc.el
;; and xml.el
;; ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el

;; elib is required (http://www.gnu.org/software/elib/elib.html)

;; if you're using emacs, you may need to put (require 'cl) in your
;; .emacs (thanks to Shawn Ledbetter for pointing this out).

;; mt.el uses the metaweblog API (see http://www.xmlrpc.com/metaWeblogApi
;; and movabletype's support for it:
;; http://www.movabletype.org/docs/mtmanual_programmatic.html#xmlrpc%20api.
;;
;; If your weblog does not support these tools, this package will NOT
;; work. To see if your movable type weblog can use XML-RPC, load
;; mt-check.cgi. If you see the following lines, you should be ok:
;;    LWP::UserAgent...
;;        Your server has LWP::UserAgent installed.

;;    SOAP::Lite...
;;        Your server has SOAP::Lite installed.
;; 
;; If not, you will have to install them; see MT's installation manual
;; for instructions.
;;
;; There are currently issues with line breaks. If you set up MT to
;; automatically convert linebreaks and you have auto-fill on in your
;; entry buffer (or fill before submitting), you will end up breaking
;; entries where auto fill wraps tags in the middle. My current
;; recommendation is to turn this off in your MT preferences and have
;; mt.el wrap your paragraphs in <p> tags. However, if you really
;; don't like this, turn off weblog-wrap-paras in customize

;; The publish flag

;; The default behaviour for MT's XML-RPC API is to always set a
;; post's status to Publish. From comments in XMLRPCServer.pm:

;; ## In 2.1 we changed the behavior of the $publish flag. Previously, 
;; ## it was used to determine the post status. That was a bad idea. 
;; ## So now entries added through XML-RPC are always set to publish, 
;; ## unless the user has set "NoPublishMeansDraft 1" in mt.cfg, which 
;; ## enables the old behavior. 

;; So the _default_ behaviour when setting publish to nil (either in
;; your configuration settings or with an explicit
;; weblog-submit-no-publish) is to create or save a post with a status
;; of publish but no site rebuild. If you change the setting in your
;; mt.cfg, the same action will set the status accordingly.

;; TODO 

;; BUGS

;; Paragraph wrapping breaks on the last paragraph if there isn't a
;; newline at the end. Current hack fix is to add newline at the end.

;;; CODE

(require 'xml-rpc)

(defgroup weblog nil
  "Emacs interface to the metaWeblogAPI."
  :group 'emacs)

(defcustom weblog-id nil
  "Id for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-username nil
  "Username for this weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-password nil
  "Password for your weblog."
  :group 'weblog
  :type 'string)

(defcustom weblog-url nil
  "Complete url to your XMLRPC service."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-count 5
  "Default number of posts to retrieve if no count supplied."
  :group 'weblog
  :type 'integer)

(defcustom weblog-publish-on-save t
  "If t, publish on save."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-wrap-paras t
  "If t, mt.el will wrap paragraphs in <p> tags, and you should turn this
  functionality off in MT. If nil, no wrapping will be done, but you
  should turn off auto-fill in your post buffers."
  :group 'weblog
  :type 'boolean)

(defcustom weblog-local-save-dir "~/.mt"
  "Used to cache weblog name and local copies of posts"
  :group 'weblog
  :type 'directory)

(defcustom weblog-auto-categories 0
  "If t, mt will automatically prompt you to set categories on new posts."
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-comments 1
  "Default value for the allow-comments field. Can be Yes, No, or Ask"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-allow-pings 1
  "Default value for the allow-pings field. If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-convert-breaks 0
  "Should MT convert line breaks? If set to Ask, you will be prompted"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-post-marker "--post follows this line--\n"
  "String to demarcate title and post."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-post-marker "--end of post--\n"
  "String to mark end of main post body."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-extended 0
  "Add an extended entry section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-extended-marker "--extended entry follows this line--\n"
  "String to mark beginning of extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-extended-marker "--end of extended--\n"
  "String to mark end of an extended entry."
  :group 'weblog
  :type 'string)

(defcustom weblog-post-buffer-excerpt 0
  "Add an excerpt section to post buffers?"
  :group 'weblog
  :type  '(choice (const :tag "Yes" 1) 
		  (const :tag "No" 0) 
		  (const :tag "Ask" 2)))

(defcustom weblog-begin-excerpt-marker "--excerpt follows this line--\n"
  "String to mark beginning of excerpt."
  :group 'weblog
  :type 'string)

(defcustom weblog-end-excerpt-marker "--end of excerpt--\n"
  "String to mark end of excerpt."
  :group 'weblog
  :group 'string)

(defface weblog-header-face
  '((((class color)
      (background dark))
     (:foreground "green2"))
    (((class color)
      (background light))
     (:foreground "MidnightBlue"))
    (t
     (:bold t :italic t)))
  "Face used for displaying headers."
  :group 'weblog)

(defface weblog-header-name-face
  '((((class color)
      (background dark))
     (:foreground "DarkGreen" :bold t))
    (((class color)
      (background light))
     (:foreground "cornflower blue" :bold t))
    (t
     (:bold t)))
  "Face used for displaying header names."
  :group 'weblog)

(defface weblog-header-separator-face
  '((((class color)
      (background dark))
     (:foreground "Black" :bold t))
    (((class color)
      (background light))
     (:foreground "Black" :bold t))
    (t
     (:bold t)))
  "Face used for displaying header names."
  :group 'weblog)


(defvar mt-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-mode-map))
    (define-key map "\C-c\C-c" 'weblog-submit-post)
    (define-key map "\C-c\C-s" 'weblog-submit-publish)
    (define-key map "\C-c\C-p" 'weblog-submit-no-publish)
    (define-key map "\C-c\C-e" 'weblog-edit-post-at-point)
    (define-key map "\C-c\C-r" 'weblog-refresh-buffer)
    (define-key map "\C-c\C-d" 'mt-cat-create-buffer)
    map))

(defvar mt-cat-mode-map
  (let ((map (make-sparse-keymap)))
    (if (functionp 'set-keymap-name)
	(set-keymap-name map 'mt-cat-mode-map))
    (suppress-keymap map)
    (define-key map "p" 'mt-cat-toggle-primary)
    (define-key map "s" 'mt-cat-toggle-secondary)
    (define-key map "\C-c\C-c" 'mt-cat-update)
    map))

(defvar weblog-mode-hook nil
  "Hook run after starting up weblog mode.")

(defvar weblog-new-post-hook nil
  "Hook to run when visiting a new post buffer")

;; attempt some font locking
(defun weblog-font-lock-make-header-matcher (regexp)
  (let ((form
	 `(lambda (limit)
	    (let ((start (point)))
	      (save-restriction
		(widen)
		(goto-char (point-min))
		(if (re-search-forward
		     (concat "^" (regexp-quote weblog-begin-post-marker) "$")
		     nil t)
		    (setq limit (min limit (match-beginning 0))))
		(goto-char start))
	      (and (< start limit)
		   (re-search-forward ,regexp limit t))))))
    (if (featurep 'bytecomp)
	(byte-compile form)
      form)))

(defvar weblog-font-lock-keywords
  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
    `((,(weblog-font-lock-make-header-matcher
	 (concat "^\\([Tt]itle:\\)" content))
       (1 'weblog-header-name-face)
       (2 'weblog-header-face nil t))
      (,(weblog-font-lock-make-header-matcher
	 (concat "^\\([Pp]ings:\\)" content))
       (1 'weblog-header-name-face)
       (2 'weblog-header-face nil t))
      (,(weblog-font-lock-make-header-matcher
	 (concat "^\\([Cc]omments:\\)" content))
       (1 'weblog-header-name-face)
       (2 'weblog-header-face nil t))
      (,(weblog-font-lock-make-header-matcher
	 (concat "^\\([Cc]onvert line breaks:\\)" content))
       (1 'weblog-header-name-face)
       (2 'weblog-header-face nil t))
      (,(weblog-font-lock-make-header-matcher
	 (concat "^\\([Pp]ost [Ii]d:\\)" content))
       (1 'weblog-header-name-face)
       (2 'weblog-header-face nil t))
      ,@`((,(concat "^\\(" (regexp-quote weblog-begin-post-marker) "\\)")
	       1 'weblog-header-separator-face))
      ,@`((,(concat "^\\(" (regexp-quote weblog-end-post-marker) "\\)")
	       1 'weblog-header-separator-face))
      ,@`((,(concat "^\\(" (regexp-quote weblog-begin-excerpt-marker) "\\)")
	       1 'weblog-header-separator-face))
      ,@`((,(concat "^\\(" (regexp-quote weblog-end-excerpt-marker) "\\)")
	       1 'weblog-header-separator-face))
      ,@`((,(concat "^\\(" (regexp-quote weblog-begin-extended-marker) "\\)")
	       1 'weblog-header-separator-face))
      ,@`((,(concat "^\\(" (regexp-quote weblog-end-extended-marker) "\\)")
	       1 'weblog-header-separator-face))))

  "Additional expressions to highlight in Weblog mode.")

;; XEmacs does it like this.  For Emacs, we have to set the
;; `font-lock-defaults' buffer-local variable.
(put 'weblog-mode 'font-lock-defaults '(weblog-font-lock-keywords t))

(defvar weblog-face-alist
  '((bold . bold-region)
    (underline . underline-region)
    (default . (lambda (b e)
		 (unbold-region b e)
		 (ununderline-region b e))))
  "Alist of mail and news faces for facemenu.
The cdr of ech entry is a function for applying the face to a region.")


(defun weblog-mode ()
  "Major mode for editing posts for a weblog."
  (interactive)
  (text-mode)
  (if (not (featurep 'xemacs))
    (set (make-local-variable 'font-lock-defaults)
	 '(weblog-font-lock-keywords t)))

  (use-local-map mt-mode-map)
  (setq mode-name "weblog")
  (setq major-mode 'weblog-mode)
  (when (featurep 'font-lock)
    (font-lock-set-defaults))

  ;; what would be nice for hooks is to have it prompt for
  ;; title/category or not depending on user preference
  (run-hooks 'weblog-mode-hook)
  (font-lock-fontify-buffer)) ;; xemacs seems to need the font lock. don't ask me, I just work here.

(defun weblog-cat-mode ()
  "Major mode for editing categories on a post."
  (interactive)
  (text-mode)
  (use-local-map mt-cat-mode-map)
  (setq mode-name "weblog-cat")
  (setq major-mode 'weblog-cat-mode)
  (setq buffer-read-only t))

(defun weblog-create-post ()
  "*Compose a weblog post."
  (interactive)
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name)))
  (erase-buffer)
  (goto-char (point-min))
  (insert "Title: \n")
  (insert "Comments: ")
  (cond 
   ((= weblog-allow-comments 1)
    (insert "Yes"))
   ((= weblog-allow-comments 2)
    (insert "Ask"))
   ((= weblog-allow-comments 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")  
  (insert "Pings: ")
  (cond 
   ((= weblog-allow-pings 1)
    (insert "Yes"))
   ((= weblog-allow-pings 2)
    (insert "Ask"))
   ((= weblog-allow-pings 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")
  (insert "Convert line breaks: ")
  (cond 
   ((= weblog-convert-breaks 1)
    (insert "Yes"))
   ((= weblog-convert-breaks 2)
    (insert "Ask"))
   ((= weblog-convert-breaks 0)
    (insert "No"))
   (t (insert "?")))
  (insert "\n")

  (insert weblog-begin-post-marker)
  (insert "\n\n")
  (insert weblog-end-post-marker)
  (if (> (weblog-add-extended-p) 0)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker)))
  (if (> (weblog-add-excerpt-p) 0)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker)))
  (beginning-of-buffer)
  (end-of-line)
  (weblog-mode)
  (run-hooks 'weblog-new-post-hook))

(defun weblog-submit-post (&optional publish)
  "*Publish current message."
  (interactive)
  (setq new-post (new-postp))
  (weblog-refresh-buffer
  (if new-post
      (mwa-new-post publish)
    (mwa-edit-post publish)))
  (if new-post
      (if (weblog-auto-categories-p)
	  (mt-cat-create-buffer))))

(defun weblog-retrieve-post (&optional post-id)
  "*Retrieves a post for a given weblog post id."
  (interactive)
  (weblog-create-post-buffer 
   (mwa-get-post (or post-id (read-from-minibuffer "Post Id: ")))))

(defun weblog-retrieve-recent-posts (&optional num)
  "*Retrieve a list of recent posts, puts in a buffer for further editing."
  (interactive "P")
  (create-posts-buffer (mwa-get-recent-posts (or num weblog-post-count))))

(defun weblog-edit-post-at-point ()
  "Edit the post at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(weblog-create-post-buffer (mwa-get-post (match-string 1)))
      (error "Couldn't determine post number"))))

(defun weblog-submit-publish ()
  "Save and publish post regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '1))

(defun weblog-submit-no-publish ()
  "Save without publish regardless of weblog-publish-on-save setting"
  (interactive)
  (weblog-submit-post '0))

(defun weblog-switch-weblog (&optional id)
  "Convenient way to switch what weblog is posted to"
  (interactive)
  (setq weblog-id (or id (read-from-minibuffer "Blog Id: ")))
  (setq weblog-name (mt-get-weblog-name weblog-id)))

(defun weblog-auto-categories-p ()
  "Returns t if a categories buffer should be setup."
  (if (> weblog-auto-categories 1)
      (if (y-or-n-p "Set categories on this post? ")
	  t
	nil)
    (if (= weblog-auto-categories 1)
	t
      nil)))

(defun weblog-allow-comments-p ()
  "Returns t if comments should be allowed for this post."
  (if (> weblog-allow-comments 1)
      (if (y-or-n-p "Allow comments on this post? ")
	  '1
	'0)
    weblog-allow-comments))

(defun weblog-allow-pings-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-allow-pings 1)
      (if (y-or-n-p "Allow pings on this post? ")
	  '1
	'0)
    weblog-allow-pings))

(defun weblog-convert-breaks-p ()
  "Returns t if trackback pings should be allowed for this post."
  (if (> weblog-convert-breaks 1)
      (if (y-or-n-p "Convert line breaks on this post? ")
	  '1
	'0)
    weblog-convert-breaks))

(defun weblog-go-to-body ()
  "Moves point to beginning of post body."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-post-marker))

(defun weblog-add-excerpt ()
  "Add an excerpt section, if one doesn't exist."
  (interactive)
  (save-excursion
    (if (weblog-go-to-excerpt)
	(error "An excerpt section already exists.")
      (search-forward weblog-end-post-marker)
      (insert (concat weblog-begin-excerpt-marker "\n" weblog-end-excerpt-marker))))
  (weblog-go-to-excerpt))

(defun weblog-go-to-excerpt ()
  "Moves point to beginning of excerpt."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-excerpt-marker nil t))

(defun weblog-add-extended ()
  "Add an extended section, if one doesn't exist."
  (interactive)
  (save-excursion
    (if (weblog-go-to-extended)
	(error "An excerpt section already exists.")
      (search-forward weblog-end-post-marker)
      (insert (concat weblog-begin-extended-marker "\n" weblog-end-extended-marker))))
  (weblog-go-to-extended))

(defun weblog-go-to-extended ()
  "Moves point to beginning of extended entry."
  (interactive)
  (beginning-of-buffer)
  (search-forward weblog-begin-extended-marker nil t))

(defun weblog-add-excerpt-p ()
  "Return t if a block for an excerpt should be added to this post."
  (if (> weblog-post-buffer-excerpt 1)
      (if (y-or-n-p "Add an excerpt block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-excerpt))

(defun weblog-add-extended-p ()
  "Return t if a block for an extended entry should be added to this post."
  (if (> weblog-post-buffer-extended 1)
      (if (y-or-n-p "Add an extended entry block to this post buffer? ")
	  '1
	'0)
    weblog-post-buffer-extended))

(defun create-posts-buffer (posts)
  "Creates a listing of retrieved posts"
  ; Needs to add a key binding for return to edit a post maybe
  (switch-to-buffer (generate-new-buffer "*weblog-posts*"))
  (insert "Recent posts:\n\n")
  (mapcar 
   (lambda (post)
     (setq post-id (cdr (assoc "postid" post)))
     (setq post-title (cdr (assoc "title" post)))
     (setq post-body (cdr (assoc "description" post)))
     (insert post-id)
     (insert " ")
     (insert post-title)
     (insert "\n"))
   posts)
  (weblog-mode)
  (goto-char (point-min)))
	  
(defun weblog-create-post-buffer (post)
  "Creates buffer filled with post info"
  ;; so we should have a struct in post
  (setq post-id (cdr (assoc "postid" post)))
  (switch-to-buffer (generate-new-buffer (get-post-buffer-name post-id )))
  (erase-buffer)
  (goto-char (point-min))
  (weblog-insert-post-contents post)
  (weblog-go-to-body)
  (end-of-line)
  (weblog-mode))

(defun get-post-buffer-name (&optional post-id)
  (setq log-name (mt-get-weblog-name weblog-id))
  (if post-id
      (concat "*post " post-id " (" log-name ")*") ; need to check if numberp?
    (concat "*post (" log-name ")*"))) ; stupid 

;; metaweblogapi implementations
(defun mwa-new-post (&optional publish)
  "Makes a new post via metaWeblogAPI newPost command"
  (xml-rpc-method-call 
   weblog-url 
   'metaWeblog.newPost 
   weblog-id 
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-edit-post (&optional publish)
  "Edits a post via metaWeblogAPI editPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.editPost
   (weblog-post-id)
   weblog-username
   weblog-password
   (list (cons "description" (weblog-post-body))
	 (cons "title" (weblog-post-title))
	 (cons "mt_allow_comments" (weblog-allow-comments-p))
	 (cons "mt_allow_pings" (weblog-allow-pings-p))
	 (cons "mt_convert_breaks" (weblog-convert-breaks-p))
	 (cons "mt_text_more" (weblog-post-extended))
	 (cons "mt_excerpt" (weblog-post-excerpt)))
   (or publish (publishp))))

(defun mwa-get-post (post-id)
  "Gets a single post via metaWeblogAPI getPost command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getPost
   post-id
   weblog-username
   weblog-password))

(defun mwa-get-recent-posts (number-of-posts)
  "Gets specified number of recent posts via metaWeblogAPI getRecentPosts command"
  (xml-rpc-method-call
   weblog-url
   'metaWeblog.getRecentPosts
   weblog-id
   weblog-username
   weblog-password
   number-of-posts))

;; MovableType XMLRPC implementation - category stuff

(defun mt-get-category-list ()
  "Gets list of categories for a weblog via mt API getCategoryList command"
  (xml-rpc-method-call
   weblog-url
   'mt.getCategoryList
   weblog-id
   weblog-username
   weblog-password))

(defun mt-get-post-categories (&optional post-id)
  "Gets categories for a post via mt API getPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.getPostCategories
   (or post-id (weblog-post-id))
   weblog-username
   weblog-password))

(defun mt-set-post-categories (post-id post-categories)
  "Sets categories for a post via mt API setPostCategories command"
  (xml-rpc-method-call
   weblog-url
   'mt.setPostCategories
   post-id
   weblog-username
   weblog-password
   post-categories))

(defun mt-get-trackback-pings ()
  "Retrieves trackback pings for an entry, if any."
  (xml-rpc-method-call
   weblog-url
   'mt.getTrackbackPings
   (weblog-post-id)))

(defun mt-publish-post (&optional post-id)
  "Rebuild the static files related to an entry."
  (xml-rpc-method-call
   weblog-url
   'mt.publishPost
   (or post-id (weblog-post-id))))

;; blogger api implementation
(defun blogger-get-users-blogs ()
  "Retrieves info about current users blogs"
  (xml-rpc-method-call
   weblog-url
   'blogger.getUsersBlogs
   '""
   weblog-username
   weblog-password))

;; support utility functions
(defun weblog-post-title ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Title:[ \t]*\\(.*\\)$" nil t)
	  (setq post-title (match-string 1))
	(read-from-minibuffer "Post Title: " post-title))
      (xml-rpc-encode post-title))))

(defun weblog-post-body ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-post-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-post-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	nil))))

(defun weblog-post-excerpt ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-excerpt-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-excerpt-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun weblog-post-extended ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (re-search-forward (concat weblog-begin-extended-marker "\\(\\(.\\|\n\\)*\\)" weblog-end-extended-marker) nil t)
	  (if weblog-wrap-paras
	      (xml-rpc-encode (wrap-paragraphs (match-string 1)))
	    (xml-rpc-encode (match-string 1)))
	'0))))

(defun xml-rpc-encode (string)
  "Replaces < with &lt; and & with &amp;"
  (let (buf)
    (save-excursion
      (unwind-protect
	  (progn
	    (setq buf (get-buffer-create " *xml-rpc-escape*"))
	    (set-buffer buf)
	    (erase-buffer)
	    (insert-string string)
	    
	    ;; This whole section is a massive massive hack
	    (goto-char (point-min))
	    (while (re-search-forward "&" nil t)
	      (replace-match "&amp;" nil nil)) ;; can't have bare &
	    (goto-char (point-min))
	    (while (re-search-forward "<" nil t)
	      (replace-match "&lt;" nil nil))  ;; can't have bare <
	    (buffer-string))
	(if buf (kill-buffer buf))))))

(defun wrap-paragraphs (string)
    (save-excursion
      (unwind-protect
	  (progn
	    (with-temp-buffer
	      (insert-string string)
	      (goto-char (point-min))
	      ;; only try and wrap if there's something non-empty to wrap
	      (if (re-search-forward "[^ \n\t\r]" nil t)
		  (progn
		    (goto-char (point-max))
		    ;; blecherous hack here
		    (while (mt-looking-back-at "\n")
		      (delete-backward-char 1))
		    (insert "\n")
		    (goto-char (point-min))
		    (while (not (eq (point) (point-max)))
		      (start-of-paragraph-text)
		      (if (not (looking-at "<p>"))  
			  (insert "<p>")) 
		      (end-of-paragraph-text) 
		      (if (not (mt-looking-back-at "</p>"))  
			  (insert "</p>"))
		      (end-of-paragraph-text))))
		    (buffer-string))))))
  

(defun weblog-post-id ()
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (search-forward (concat "\n" weblog-begin-post-marker))
      (narrow-to-region (point-min) (point))
      
      (goto-char (point-min))
      (if (re-search-forward "^Post Id:[ \t]*\\([0-9]*\\).*$" nil t)
	  (setq post-id (match-string 1))
	(setq post-id nil)))))

(defun weblog-insert-post-contents (post)
  (setq post-id (cdr (assoc "postid" post)))
  (setq post-title (cdr (assoc "title" post)))
  (setq post-body (cdr (assoc "description" post)))
  (setq post-excerpt (cdr (assoc "mt_excerpt" post)))
  (setq post-extended (cdr (assoc "mt_text_more" post)))
  (setq post-comments-allowed (cdr (assoc "mt_allow_comments" post)))
  (setq post-pings-allowed (cdr (assoc "mt_allow_pings" post)))
  (setq post-convert-breaks (cdr (assoc "mt_convert_breaks" post)))
  (insert "Post Id: ")
  (insert post-id)
  (insert " [erase this line to create a new post]\n")
  (insert "Title: ")
  (insert post-title)
  (insert "\n")
  (insert "Comments: ")
  (if post-comments-allowed
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert "Pings: ")
  (if post-pings-allowed
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert "Convert line breaks: ")
  (if post-convert-breaks
      (insert "Yes")
    (insert "No"))
  (insert "\n")
  (insert weblog-begin-post-marker)
  (insert post-body)
  (insert "\n")
  (insert weblog-end-post-marker)
  (if (and (not (string= post-extended "")) post-extended)
      (insert (concat weblog-begin-extended-marker post-extended "\n" weblog-end-extended-marker)))
  (if (and (not (string= post-excerpt "")) post-excerpt)
      (insert (concat weblog-begin-excerpt-marker post-excerpt "\n" weblog-end-excerpt-marker))))

(defun weblog-refresh-buffer (&optional post-id)
  "Refreshes content of current buffer with whatever mt server has."
  (interactive)
  (setq pm (point-max))
  (goto-char (point-max))
  (if (stringp post-id)
      (setq id post-id)
    (setq id (weblog-post-id)))
  (weblog-insert-post-contents
   (mwa-get-post id))
  (delete-region (point-min) pm)
  (weblog-go-to-body))

(defun new-postp ()
  "Return t if buffer is a new post."
  (not (weblog-post-id)))

(defun publishp ()
  "Return 1 if publish, 0 otherwise."
  (if weblog-publish-on-save
      (setq publish '1)
    (setq publish '0)))

(defun mt-looking-back-at (regexp &optional bound)
  "Return t if text before point matches REGEXP.
Modifies the match data. If supplied, BOUND means not to look farther
back that that many characters before point. Otherwise, it defaults to
\(length REGEXP), which is good enough when REGEXP is a simple
string."
  ;; taken from mmm-mode - mmm-utils.el
  (eq (point)
      (save-excursion
        (and (re-search-backward regexp
               (- (point) (or bound (length regexp)))
               t)
             (match-end 0)))))

(defun mt-clean-body (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward "&#xd;" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-get-weblog-name (&optional log-id)
  "retrieves name of a weblog given an id, either from local file or net"
  (if (mt-weblog-file-exists-p (or log-id weblog-id))
      (mt-read-weblog-name (or log-id weblog-id))
    (mt-store-weblog-name (mt-fetch-weblog-name (or log-id weblog-id)))))

(defun mt-weblog-file-exists-p (log-id)
  "Tests to see if the weblog name file exists"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (file-exists-p weblog-file-name))

(defun mt-read-weblog-name (log-id)
  "Reads the weblog name from a file"
  (with-temp-buffer
    (insert-file-contents (concat weblog-local-save-dir "/" "weblog." log-id))
    (goto-char (point-min))
    (while (re-search-forward "\n" nil t)
      (replace-match "" nil nil))
    (buffer-string)))

(defun mt-store-weblog-name (weblog-name)
  "Stores the weblog name in a file"
  (setq weblog-file-name (concat weblog-local-save-dir "/" "weblog." log-id))
  (if (not (file-directory-p weblog-local-save-dir))
      (make-directory weblog-local-save-dir))
  (with-temp-buffer
    (insert weblog-name)
    (insert "\n")
    (append-to-file (point-min) (point-max) weblog-file-name))
  weblog-name)

(defun mt-fetch-weblog-name (log-id)
  "Fetches weblog name from server using XML-RPC"
  (setq weblog-name nil)
  (mapc
   (lambda (log-info)
     (if (string= (or log-id weblog-id) (cdr (assoc "blogid" log-info)))
	 (setq weblog-name (cdr (assoc "blogName" log-info)))))
   (blogger-get-users-blogs))
  weblog-name)


;; category handling stuff

;; Here's the basics of what I'd like to do:
;; - have a buffer created (probably split the window) that gives the
;;   categories available
;; - allow user to mark primary and secondary categories. Only one
;;   primary category is allowed, as many secondary as necessary.
;; - an update command that sets the categories on a post.
(require 'cookie)

(defvar mt-cat-col nil)

(defvar mt-cat-buf "*Category Selection*")

(defun mt-cat-create-buffer (&optional post-id)
  "Creates a buffer filled with categories."
  (interactive)
  (setq post-id (or post-id (or (weblog-get-post-id-at-point) (weblog-post-id))))
  (split-window)
  (save-excursion
    (set-buffer (get-buffer-create mt-cat-buf))
    (setq buffer-read-only nil)
    (erase-buffer))
  (setq mt-cat-col (mt-cat-create-cookie-collection post-id))
  (mt-cat-enter-cookies post-id (mt-get-post-categories post-id))
  (other-window 1)
  (switch-to-buffer mt-cat-buf)
  
  (weblog-cat-mode))

(defun weblog-get-post-id-at-point ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "\\(^[0-9]+\\)[ \t]+.*$" nil t)
	(match-string 1))))


(defun mt-cat-create-cookie-collection (post-id)
  (collection-create
   mt-cat-buf
  (function mt-cat-pp)
  (concat "Post " post-id " category selection\n") 
  "\n+ Primary category\n- Secondary category" 0))

(defun mt-cat-enter-cookies (post-id post-categories)
  (collection-append-cookies 
   mt-cat-col
   (mapcar 
    (lambda (category)
      (setq cat-id 
	    (cdr (assoc "categoryId" category)))
      (setq cat-primary 
	    (mt-post-primary post-categories))
      (setq cat-secondary 
	    (mt-post-secondary post-categories))
      (list (cons "cat-id" cat-id)
	    (cons "cat-name" 
		  (cdr (assoc "categoryName" category)))
	    (cons "primary" 
		  (is-primary-p cat-id cat-primary))
	    (cons "secondary" 
		  (is-secondary-p cat-id cat-secondary))))
    (mt-get-category-list))))

(defun is-primary-p (cat-id cat-primary)
  (if (string= cat-id cat-primary)
      t
    nil))

(defun is-secondary-p (cat-id cat-secondary)
  (if (member cat-id cat-secondary)
      t
    nil))

(defun mt-post-primary (post-categories)
  "Returns the category id of the primary category for a post"
  ;; this is a bit hackish and inefficient, as we'll continue looping
  ;; over the list of categories even after we've got our primary
  (let (primary)
    (mapc
     (lambda (category)
       (if (cdr (assoc "isPrimary" category))
	   (setq primary (cdr (assoc "categoryId" category)))))
     post-categories)
    primary))
       
(defun mt-post-secondary (post-categories)
  "Returns a list of the category id(s) of the secondary categories
  for a post"
  (interactive)
  (mapcar
   (lambda (category)
     (if (not (cdr (assoc "isPrimary" category)))
	 (cdr (assoc "categoryId" category))
       nil))
   post-categories))

(defun mt-cat-get-tin (pos)
  (interactive "d")
  (mt-cat-mark-primary cookie))

(defun mt-cat-toggle-primary (pos)
  "toggles primary setting of this category"
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	 (cookie (tin-cookie mt-cat-col tin)))
  (cookie-map
   (function (lambda (cat)
	       ;; if this is our primary cat, toggle it
	       ;; othewise, mark the primary field nil
	       ;; this should enforce only one primary cat at a time,
	       ;; also sets secondary to nil
	       (if (string= (cdr (assoc "cat-id" cookie)) (cdr (assoc "cat-id" cat)))
		   (progn
		     (setcdr (assoc "primary" cat) (mt-cat-toggle (cdr (assoc "primary" cat))))
		     (setcdr (assoc "secondary" cat) nil))
		 (setcdr (assoc "primary" cat) nil))
	       t))
   mt-cat-col)))

(defun mt-cat-toggle-secondary (pos)
  (interactive "d")
  (let* ((tin (tin-locate mt-cat-col pos))
	(cookie (tin-cookie mt-cat-col tin)))

  (setcdr (assoc "secondary" cookie) (mt-cat-toggle (cdr (assoc "secondary" cookie))))
  (setcdr (assoc "primary" cookie) nil)
  (collection-refresh mt-cat-col)
  (goto-char pos))) ; lazy, but why test?


(defun mt-cat-toggle (bool)
  (if bool
      nil
    t))

(defun mt-cat-update ()
  "Sets the category information on the post on the server"
  (interactive)
  (mt-set-post-categories (mt-cat-post-id) (mt-cats-as-array))
  (bury-buffer)
  (delete-window))

(defun mt-cat-post-id ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^Post \\([0-9]*\\).*" nil t)
	(match-string 1))))

(defun mt-cats-as-array ()
  (interactive)
  (mt-cat-get-struct (append (get-primary-cat) (get-secondary-cats))))

(defun mt-cat-get-struct (cats)
  (mapcar 
   (lambda (cat)
     (list (cons "categoryId" (cdr (assoc "cat-id" cat)))))
   cats))
  
(defun get-primary-cat ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-primary-p)))

(defun get-secondary-cats ()
  (interactive)
  (collection-collect-cookie mt-cat-col (function is-marked-secondary-p)))

(defun is-marked-primary-p (cat)
  (if (cdr (assoc "primary" cat))
      t
    nil))

(defun is-marked-secondary-p (cat)
  (if (cdr (assoc "secondary" cat))
      t
    nil))
  
(defun mt-cat-pp (mt-cat-info)
  "pretty printer for cookie collection"
  (insert "[")
  (cond 
   ((cat-info-primary-p mt-cat-info)
    (insert "+"))
   ((cat-info-secondary-p mt-cat-info)
    (insert "-"))
   (t (insert " ")))
  (insert (concat (cdr (assoc "cat-id" mt-cat-info)) " ]"))
  (insert " ")
  (insert (cdr (assoc "cat-name" mt-cat-info))))

(defun cat-info-primary-p (mt-cat-info)
  (if (cdr (assoc "primary" mt-cat-info))
      t
    nil))

(defun cat-info-secondary-p (mt-cat-info)
  (if (cdr (assoc "secondary" mt-cat-info))
      t
    nil))





(provide 'mt)

;;; mt.el ends here

--=-=-=



-- 
Bill Stilwell                               
bill@marginalia.org                        
It's all margins.
Oh, just read my weblog: http://www.marginalia.org

--=-=-=--