;;; ljablog.el -- elisp mode to post blog entries to both advogato.org and livejouranl

;; bits and pieces stolen from ljupdate (http://www.nongnu.org/ljupdate/) and
;; advogato.el (http://www.hackgnu.org/files/advogato.el). ljupdate and 
;; advogato.el are copyrighted by their respective owners. 

;; ljablog is Copyright (C) 2004 Muli Ben-Yehuda <mulix@mulix.org>.

;; $Id: ljablog.el,v 1.10 2004/02/17 19:26:22 muli Exp $ 

;; ljablog.el 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.

;; ljablog.el 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.

;; ChangeLog
;;
;; Mon Feb 16 21:51:46 2004 add a 'pre-post' hook to the blog structure, 
;;   and use it to turn on HTML mode unconditionally in lj (since advogato 
;;   posts are always HTML)
;; Mon Feb 16 14:43:07 2004 - define a blog structure and use that in 
;;   ljablog-post, rather than explicit positions in a list 
;; Sun Feb 15 19:51:30 2004 - allow to set a 'do post' flag for each
;;   blog 
;; Sat Feb 14 00:29:29 2004 - set ljablog-debug-do-post to 't', to 
;;   make posting enabled by default 
;; Sat Feb 14 00:26:52 2004 - rewrite ljablog-post to be lispish, 
;;   not procedural, and potentially support more blogs. Also fix a 
;;   buglet where we would call lj mode's compose hooks rather than 
;;   ljablog's. 
;;
;; TODO 
;; 
;; - support post-and-exit
;; - clean up the leftover temporary buffers
;; - if an *ljablog* buffer already exists, don't erase it (!)
;;   (althogh that's what lj mode does)...  
;; - support lj mode style headers in advo mode, in particulr the
;;   X-Is-HTML header 
;; - if X-Is-HTML is 'no', munge the text before posting it to
;;   advogato to add <p> tags
;; 

(defvar ljablog-update-mode-map nil
  "Keyboard mapping used by `ljablog-update-mode'.")

(defvar ljablog-update-mode-abbrev-table nil
  "Local abbrev table for ljablog-update mode.")

(define-abbrev-table 'ljablog-update-mode-abbrev-table ())

(defstruct blog 
  compose-func
  pre-post-hook
  post-func
  debug-really-post)

(unless ljablog-update-mode-map
  (setq ljablog-update-mode-map (make-sparse-keymap))
  (set-keymap-parent ljablog-update-mode-map text-mode-map)
  (define-key ljablog-update-mode-map "\C-c?" 'describe-mode)
;;  (define-key ljablog-update-mode-map "\C-c\C-c" 'ljablog-post-and-exit)
  (define-key ljablog-update-mode-map "\C-c\C-k" 'ljablog-kill-buffer)
  (define-key ljablog-update-mode-map "\C-c\C-s" 'ljablog-post))

(defvar ljablog-compose-hook nil
  "Hooks to be called on ljablog-compose startup")

(defun ljablog-update-mode ()
  "Major mode for editing a ljablog entry.
   Similar to `mail-mode' and `text-mode', but with additional commands:
\\[ljablog-post] `ljablog-post' (post the update)	
\\[ljablog-post-and-exit] `ljablog-post-and-exit'
\\[ljablog-kill-buffer] throws away the buffer, if you change your mind.
\\[describe-mode] should tell you all sorts of neat things about this mode."
  (interactive)

  (kill-all-local-variables)
  (setq major-mode 'ljablog-update-mode)
  (setq mode-name "ljablog")

  ;; Since we're pretending to be like mail, why don't we let the mail
  ;; font locking do the work for us? :)
  (set (make-local-variable 'font-lock-defaults)
       '(mail-font-lock-keywords t))

  (use-local-map ljablog-update-mode-map)

  ;; Abbrev support
  (setq local-abbrev-table ljablog-update-mode-abbrev-table)

  ;; Make paragraph fill functions work correctly
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat (regexp-quote mail-header-separator)
				"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
				"\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
				"-- $\\|---+$\\|"
				page-delimiter))
  (setq paragraph-separate paragraph-start)

  ;; But if you don't like the above two lines, why not leave them
  ;; there and add a hook that will fix things for you? :) Some
  ;; suggested things to turn on in this hook: flyspell (we get spell
  ;; checking for free. yay.)
  (run-hooks 'ljablog-update-mode-hook))

(defun ljab-turn-lj-html-on ()
  "Turn the X-LJ-Is-HTML flag on in this *LiveJournal* buffer"
  (goto-char (point-min))
  (if (re-search-forward "^X-LJ-Is-HTML:[ ]" (ljc-mail-header-end) t)
      (progn
	(kill-entire-line)
	(insert "X-LJ-Is-HTML: yes\n"))
    (lj--message 1 "buffer has no X-LJ-Is-HTML header!")))
    
(defun ljablog-post ()
  "Post a ljablog entry to both livejournal and advogato."
  (interactive)
  (let 
      ((blogs (list 
	       (make-blog :compose-func 'lj-compose
			  :pre-post-hook 'ljab-turn-lj-html-on
			  :post-func 'lj-post
			  :debug-really-post t)
	       (make-blog :compose-func 'advogato-start-post
			  :post-func 'advogato-save-post
			  :debug-really-post t)))
       (buffer (current-buffer)))
    (mapcar 
     (lambda (blog) 
       (set-buffer buffer)
       (copy-region-as-kill (point-min) (point-max))
       (funcall (blog-compose-func blog))
       (end-of-buffer)
       (yank)
       (let ((hook (blog-pre-post-hook blog))
	     (debug (blog-debug-really-post blog))
	     (post (blog-post-func blog)))
	 (when hook
	   (funcall hook))
	 (when debug
	   (funcall post))))
     blogs)))

(defun ljablog-compose ()
  "Compose a ljablog entry."
  (interactive)
  (switch-to-buffer (get-buffer-create "*ljablog*"))
  (delete-region (point-min) (point-max))
  (or (eq major-mode 'ljablog-update-mode) (ljablog-update-mode))
  (set-buffer-modified-p nil)
  ;; call our startup hooks 
  (mapcar 
       (lambda (x) (funcall x))
       ljablog-compose-hook))

(defun ljablog-kill-buffer ()
  "Kill current buffer."
  (interactive)
  (when (or (not (buffer-modified-p))
	    (y-or-n-p "Buffer modified, kill anyway? "))
    (kill-buffer (current-buffer))))

(provide 'ljablog)